simple-sql-parser 0.6.0 → 0.7.0
raw patch · 66 files changed
+16490/−16301 lines, 66 filesdep +containersdep +megaparsecdep +parser-combinatorsdep −parsecdep −prettydep ~mtldep ~tastysetup-changednew-component:exe:SimpleSQLParserTool
Dependencies added: containers, megaparsec, parser-combinators, prettyprinter, simple-sql-parser, text
Dependencies removed: parsec, pretty
Dependency ranges changed: mtl, tasty
Files
- LICENSE +1/−1
- Language/SQL/SimpleSQL/Combinators.lhs +0/−107
- Language/SQL/SimpleSQL/Dialect.hs +555/−0
- Language/SQL/SimpleSQL/Dialect.lhs +0/−540
- Language/SQL/SimpleSQL/Errors.lhs +0/−51
- Language/SQL/SimpleSQL/Lex.hs +940/−0
- Language/SQL/SimpleSQL/Lex.lhs +0/−717
- Language/SQL/SimpleSQL/Parse.hs +2370/−0
- Language/SQL/SimpleSQL/Parse.lhs +0/−2152
- Language/SQL/SimpleSQL/Pretty.hs +894/−0
- Language/SQL/SimpleSQL/Pretty.lhs +0/−820
- Language/SQL/SimpleSQL/Syntax.hs +771/−0
- Language/SQL/SimpleSQL/Syntax.lhs +0/−729
- README +2/−2
- Setup.hs +0/−2
- changelog +16/−0
- examples/SimpleSQLParserTool.hs +105/−0
- simple-sql-parser.cabal +37/−79
- tests/Language/SQL/SimpleSQL/CreateIndex.hs +18/−0
- tests/Language/SQL/SimpleSQL/CustomDialect.hs +28/−0
- tests/Language/SQL/SimpleSQL/EmptyStatement.hs +21/−0
- tests/Language/SQL/SimpleSQL/ErrorMessages.hs +156/−0
- tests/Language/SQL/SimpleSQL/FullQueries.hs +40/−0
- tests/Language/SQL/SimpleSQL/GroupBy.hs +238/−0
- tests/Language/SQL/SimpleSQL/LexerTests.hs +398/−0
- tests/Language/SQL/SimpleSQL/MySQL.hs +43/−0
- tests/Language/SQL/SimpleSQL/Odbc.hs +53/−0
- tests/Language/SQL/SimpleSQL/Oracle.hs +30/−0
- tests/Language/SQL/SimpleSQL/Postgres.hs +279/−0
- tests/Language/SQL/SimpleSQL/QueryExprComponents.hs +209/−0
- tests/Language/SQL/SimpleSQL/QueryExprs.hs +27/−0
- tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs +330/−0
- tests/Language/SQL/SimpleSQL/SQL2011Bits.hs +234/−0
- tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs +555/−0
- tests/Language/SQL/SimpleSQL/SQL2011Queries.hs +4520/−0
- tests/Language/SQL/SimpleSQL/SQL2011Schema.hs +2158/−0
- tests/Language/SQL/SimpleSQL/ScalarExprs.hs +433/−0
- tests/Language/SQL/SimpleSQL/TableRefs.hs +108/−0
- tests/Language/SQL/SimpleSQL/TestTypes.hs +45/−0
- tests/Language/SQL/SimpleSQL/Tests.hs +180/−0
- tests/Language/SQL/SimpleSQL/Tpch.hs +688/−0
- tests/RunTests.hs +8/−0
- tools/Fixity.lhs +0/−702
- tools/Language/SQL/SimpleSQL/CustomDialect.lhs +0/−27
- tools/Language/SQL/SimpleSQL/ErrorMessages.lhs +0/−150
- tools/Language/SQL/SimpleSQL/FullQueries.lhs +0/−39
- tools/Language/SQL/SimpleSQL/GroupBy.lhs +0/−235
- tools/Language/SQL/SimpleSQL/LexerTests.lhs +0/−335
- tools/Language/SQL/SimpleSQL/MySQL.lhs +0/−40
- tools/Language/SQL/SimpleSQL/Odbc.lhs +0/−52
- tools/Language/SQL/SimpleSQL/Oracle.lhs +0/−29
- tools/Language/SQL/SimpleSQL/Postgres.lhs +0/−274
- tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs +0/−209
- tools/Language/SQL/SimpleSQL/QueryExprs.lhs +0/−24
- tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs +0/−315
- tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs +0/−219
- tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs +0/−544
- tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs +0/−4341
- tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs +0/−2057
- tools/Language/SQL/SimpleSQL/ScalarExprs.lhs +0/−417
- tools/Language/SQL/SimpleSQL/TableRefs.lhs +0/−105
- tools/Language/SQL/SimpleSQL/TestTypes.lhs +0/−37
- tools/Language/SQL/SimpleSQL/Tests.lhs +0/−166
- tools/Language/SQL/SimpleSQL/Tpch.lhs +0/−683
- tools/RunTests.lhs +0/−8
- tools/SimpleSqlParserTool.lhs +0/−93
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013, 2014, 2015, Jake Wheat+Copyright 2013 - 2024, Jake Wheat and the simple-sql-parser contributors. All rights reserved.
− Language/SQL/SimpleSQL/Combinators.lhs
@@ -1,107 +0,0 @@--> -- | This module contains some generic combinators used in the-> -- parser. None of the parsing which relies on the local lexers is-> -- in this module. Some of these combinators have been taken from-> -- other parser combinator libraries other than Parsec.--> module Language.SQL.SimpleSQL.Combinators-> (optionSuffix-> ,(<??>)-> ,(<??.>)-> ,(<??*>)-> ,(<$$>)-> ,(<$$$>)-> ,(<$$$$>)-> ,(<$$$$$>)-> ) where--> import Control.Applicative ((<**>))-> import Text.Parsec (option,many)-> import Text.Parsec.String (GenParser)--a possible issue with the option suffix is that it enforces left-associativity when chaining it recursively. Have to review-all these uses and figure out if any should be right associative-instead, and create an alternative suffix parser--This function style is not good, and should be replaced with chain and-<??> which has a different type--> optionSuffix :: (a -> GenParser t s a) -> a -> GenParser t s a-> optionSuffix p a = option a (p a)---parses an optional postfix element and applies its result to its left-hand result, taken from uu-parsinglib--TODO: make sure the precedence higher than <|> and lower than the-other operators so it can be used nicely--> (<??>) :: GenParser t s a -> GenParser t s (a -> a) -> GenParser t s a-> p <??> q = p <**> option id q---Help with left factored parsers. <$$> is like an analogy with <**>:--f <$> a <*> b--is like--a <**> (b <$$> f)--f <$> a <*> b <*> c--is like--a <**> (b <**> (c <$$$> f))--> (<$$>) :: Applicative f =>-> f b -> (a -> b -> c) -> f (a -> c)-> (<$$>) pa c = pa <**> pure (flip c)--> (<$$$>) :: Applicative f =>-> f c -> (a -> b -> c -> t) -> f (b -> a -> t)-> p <$$$> c = p <**> pure (flip3 c)--> (<$$$$>) :: Applicative f =>-> f d -> (a -> b -> c -> d -> t) -> f (c -> b -> a -> t)-> p <$$$$> c = p <**> pure (flip4 c)--> (<$$$$$>) :: Applicative f =>-> f e -> (a -> b -> c -> d -> e -> t) -> f (d -> c -> b -> a -> t)-> p <$$$$$> c = p <**> pure (flip5 c)--Surely no-one would write code like this seriously?---composing suffix parsers, not sure about the name. This is used to add-a second or more suffix parser contingent on the first suffix parser-succeeding.--> (<??.>) :: GenParser t s (a -> a) -> GenParser t s (a -> a) -> GenParser t s (a -> a)-> (<??.>) pa pb = (.) `c` pa <*> option id pb-> -- todo: fix this mess-> where c = (<$>) . flip---0 to many repeated applications of suffix parser--> (<??*>) :: GenParser t s a -> GenParser t s (a -> a) -> GenParser t s a-> p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)---These are to help with left factored parsers:--a <**> (b <**> (c <**> pure (flip3 ctor)))--Not sure the names are correct, but they follow a pattern with flip-a <**> (b <**> pure (flip ctor))--> flip3 :: (a -> b -> c -> t) -> c -> b -> a -> t-> flip3 f a b c = f c b a--> flip4 :: (a -> b -> c -> d -> t) -> d -> c -> b -> a -> t-> flip4 f a b c d = f d c b a--> flip5 :: (a -> b -> c -> d -> e -> t) -> e -> d -> c -> b -> a -> t-> flip5 f a b c d e = f e d c b a
+ Language/SQL/SimpleSQL/Dialect.hs view
@@ -0,0 +1,555 @@+++-- 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+ diKeywords :: [Text]+ -- | keywords with identifier exception+ ,diIdentifierKeywords :: [Text]+ -- | keywords with app exception+ ,diAppKeywords :: [Text]+ -- | keywords with type exception plus all the type names which+ -- are multiple words+ ,diSpecialTypeNames :: [Text]+ -- | allow ansi fetch first syntax+ ,diFetchFirst :: Bool+ -- | allow limit keyword (mysql, postgres,+ -- ...)+ ,diLimit :: Bool+ -- | allow parsing ODBC syntax+ ,diOdbc :: Bool+ -- | allow quoting identifiers with \`backquotes\`+ ,diBackquotedIden :: Bool+ -- | allow quoting identifiers with [square brackets]+ ,diSquareBracketQuotedIden :: Bool+ -- | allow identifiers with a leading at @example+ ,diAtIdentifier :: Bool+ -- | allow identifiers with a leading \# \#example+ ,diHashIdentifier :: Bool+ -- | allow positional identifiers like this: $1 + ,diPositionalArg :: Bool+ -- | allow postgres style dollar strings+ ,diDollarString :: Bool+ -- | allow strings with an e - e"example"+ ,diEString :: Bool+ -- | allow postgres style symbols+ ,diPostgresSymbols :: Bool+ -- | allow sql server style symbols+ ,diSqlServerSymbols :: Bool+ -- | allow sql server style for CONVERT function in format CONVERT(data_type(length), expression, style)+ ,diConvertFunction :: Bool+ -- | allow creating autoincrement columns+ ,diAutoincrement :: Bool+ -- | allow omitting the comma between constraint clauses+ ,diNonCommaSeparatedConstraints :: Bool+ }+ deriving (Eq,Show,Read,Data,Typeable)++-- | ansi sql 2011 dialect+ansi2011 :: Dialect+ansi2011 = Dialect {diKeywords = ansi2011ReservedKeywords+ ,diIdentifierKeywords = []+ ,diAppKeywords = ["set"]+ ,diSpecialTypeNames = ansi2011TypeNames+ ,diFetchFirst = True+ ,diLimit = False+ ,diOdbc = False+ ,diBackquotedIden = False+ ,diSquareBracketQuotedIden = False+ ,diAtIdentifier = False+ ,diHashIdentifier = False+ ,diPositionalArg = False+ ,diDollarString = False+ ,diEString = False+ ,diPostgresSymbols = False+ ,diSqlServerSymbols = False+ ,diConvertFunction = False + ,diAutoincrement = False+ ,diNonCommaSeparatedConstraints = False+ }++-- | mysql dialect+mysql :: Dialect+mysql = addLimit ansi2011 {diFetchFirst = False+ ,diBackquotedIden = True+ }++-- | postgresql dialect+postgres :: Dialect+postgres = addLimit ansi2011 {diPositionalArg = True+ ,diDollarString = True+ ,diEString = True+ ,diPostgresSymbols = True}++-- | oracle dialect+oracle :: Dialect+oracle = ansi2011 -- {}++-- | microsoft sql server dialect+sqlserver :: Dialect+sqlserver = ansi2011 {diSquareBracketQuotedIden = True+ ,diAtIdentifier = True+ ,diHashIdentifier = True+ ,diOdbc = True+ ,diSqlServerSymbols = True+ ,diConvertFunction = True}++addLimit :: Dialect -> Dialect+addLimit d = 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 =+ [--"abs" -- function+ "all" -- keyword only?+ ,"allocate" -- keyword+ ,"alter" -- keyword+ ,"and" -- keyword+ --,"any" -- keyword? and function+ ,"are" -- keyword+ ,"array" -- keyword, and used in some special places, like array[...], and array(subquery)+ --,"array_agg" -- function+ -- ,"array_max_cardinality" -- function+ ,"as" -- keyword+ ,"asensitive" -- keyword+ ,"asymmetric" -- keyword+ ,"at" -- keyword+ ,"atomic" -- keyword+ ,"authorization" -- keyword+ --,"avg" -- function+ ,"begin" -- keyword+ --,"begin_frame" -- identifier+ --,"begin_partition" -- identifier+ ,"between" -- keyword+ ,"bigint" -- type+ ,"binary" -- type+ ,"blob" -- type+ ,"boolean" -- type+ ,"both" -- keyword+ ,"by" -- keyword+ ,"call" -- keyword+ ,"called" -- keyword+ -- ,"cardinality" -- function + identifier?+ ,"cascaded" -- keyword+ ,"case" -- keyword+ ,"cast" -- special function+ -- ,"ceil" -- function+ -- ,"ceiling" -- function+ ,"char" -- type (+ keyword?)+ --,"char_length" -- function+ ,"character" -- type+ --,"character_length" -- function+ ,"check" -- keyword+ ,"clob" -- type+ ,"close" -- keyword+ -- ,"coalesce" -- function+ ,"collate" -- keyword+ --,"collect" -- function+ ,"column" -- keyword+ ,"commit" -- keyword+ ,"condition" -- keyword+ ,"connect" -- keyword+ ,"constraint" --keyword+ --,"contains" -- keyword?+ --,"convert" -- function?+ --,"corr" -- function+ ,"corresponding" --keyword+ --,"count" --function+ --,"covar_pop" -- function+ --,"covar_samp" --function+ ,"create" -- keyword+ ,"cross" -- keyword+ ,"cube" -- keyword+ --,"cume_dist" -- function+ ,"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+ ,"cursor" -- keyword+ ,"cycle" --keyword+ ,"date" -- type+ --,"day" -- keyword? - the parser needs it to not be a keyword to parse extract at the moment+ ,"deallocate" -- keyword+ ,"dec" -- type+ ,"decimal" -- type+ ,"declare" -- keyword+ --,"default" -- identifier + keyword+ ,"delete" -- keyword+ --,"dense_rank" -- functino+ ,"deref" -- keyword+ ,"describe" -- keyword+ ,"deterministic"+ ,"disconnect"+ ,"distinct"+ ,"double"+ ,"drop"+ ,"dynamic"+ ,"each"+ --,"element"+ ,"else"+ ,"end"+ -- ,"end_frame" -- identifier+ -- ,"end_partition" -- identifier+ ,"end-exec" -- no idea what this is+ ,"equals"+ ,"escape"+ --,"every"+ ,"except"+ ,"exec"+ ,"execute"+ ,"exists"+ ,"exp"+ ,"external"+ ,"extract"+ --,"false"+ ,"fetch"+ ,"filter"+ -- ,"first_value"+ ,"float"+ --,"floor"+ ,"for"+ ,"foreign"+ -- ,"frame_row" -- identifier+ ,"free"+ ,"from"+ ,"full"+ ,"function"+ --,"fusion"+ ,"get"+ ,"global"+ ,"grant"+ ,"group"+ --,"grouping"+ ,"groups"+ ,"having"+ ,"hold"+ --,"hour"+ ,"identity"+ ,"in"+ ,"indicator"+ ,"inner"+ ,"inout"+ ,"insensitive"+ ,"insert"+ ,"int"+ ,"integer"+ ,"intersect"+ --,"intersection"+ ,"interval"+ ,"into"+ ,"is"+ ,"join"+ --,"lag"+ ,"language"+ ,"large"+ --,"last_value"+ ,"lateral"+ --,"lead"+ ,"leading"+ ,"left"+ ,"like"+ ,"like_regex"+ --,"ln"+ ,"local"+ ,"localtime"+ ,"localtimestamp"+ --,"lower"+ ,"match"+ --,"max"+ ,"member"+ ,"merge"+ ,"method"+ --,"min"+ --,"minute"+ --,"mod"+ ,"modifies"+ --,"module"+ --,"month"+ ,"multiset"+ ,"national"+ ,"natural"+ ,"nchar"+ ,"nclob"+ ,"new"+ ,"no"+ ,"none"+ ,"normalize"+ ,"not"+ --,"nth_value"+ ,"ntile"+ --,"null"+ --,"nullif"+ ,"numeric"+ ,"octet_length"+ ,"occurrences_regex"+ ,"of"+ ,"offset"+ ,"old"+ ,"on"+ ,"only"+ ,"open"+ ,"or"+ ,"order"+ ,"out"+ ,"outer"+ ,"over"+ ,"overlaps"+ ,"overlay"+ ,"parameter"+ ,"partition"+ ,"percent"+ --,"percent_rank"+ --,"percentile_cont"+ --,"percentile_disc"+ ,"period"+ ,"portion"+ ,"position"+ ,"position_regex"+ --,"power"+ ,"precedes"+ ,"precision"+ ,"prepare"+ ,"primary"+ ,"procedure"+ ,"range"+ --,"rank"+ ,"reads"+ ,"real"+ ,"recursive"+ ,"ref"+ ,"references"+ ,"referencing"+ --,"regr_avgx"+ --,"regr_avgy"+ --,"regr_count"+ --,"regr_intercept"+ --,"regr_r2"+ --,"regr_slope"+ --,"regr_sxx"+ --,"regr_sxy"+ --,"regr_syy"+ ,"release"+ ,"result"+ ,"return"+ ,"returns"+ ,"revoke"+ ,"right"+ ,"rollback"+ ,"rollup"+ --,"row"+ --,"row_number"+ ,"rows"+ ,"savepoint"+ ,"scope"+ ,"scroll"+ ,"search"+ --,"second"+ ,"select"+ ,"sensitive"+ --,"session_user"+ ,"set"+ ,"similar"+ ,"smallint"+ --,"some"+ ,"specific"+ ,"specifictype"+ ,"sql"+ ,"sqlexception"+ ,"sqlstate"+ ,"sqlwarning"+ --,"sqrt"+ --,"start"+ ,"static"+ --,"stddev_pop"+ --,"stddev_samp"+ ,"submultiset"+ --,"substring"+ ,"substring_regex"+ ,"succeeds"+ --,"sum"+ ,"symmetric"+ ,"system"+ --,"system_time"+ --,"system_user"+ ,"table"+ ,"tablesample"+ ,"then"+ ,"time"+ ,"timestamp"+ ,"timezone_hour"+ ,"timezone_minute"+ ,"to"+ ,"trailing"+ ,"translate"+ ,"translate_regex"+ ,"translation"+ ,"treat"+ ,"trigger"+ ,"truncate"+ --,"trim"+ --,"trim_array"+ --,"true"+ ,"uescape"+ ,"union"+ ,"unique"+ --,"unknown"+ ,"unnest"+ ,"update"+ ,"upper"+ --,"user"+ ,"using"+ --,"value"+ ,"values"+ ,"value_of"+ --,"var_pop"+ --,"var_samp"+ ,"varbinary"+ ,"varchar"+ ,"varying"+ ,"versioning"+ ,"when"+ ,"whenever"+ ,"where"+ --,"width_bucket"+ ,"window"+ ,"with"+ ,"within"+ ,"without"+ --,"year"+ ]+++ansi2011TypeNames :: [Text]+ansi2011TypeNames =+ ["double precision"+ ,"character varying"+ ,"char varying"+ ,"character large object"+ ,"char large object"+ ,"national character"+ ,"national char"+ ,"national character varying"+ ,"national char varying"+ ,"national character large object"+ ,"nchar large object"+ ,"nchar varying"+ ,"bit varying"+ ,"binary large object"+ ,"binary varying"+ -- reserved keyword typenames:+ ,"array"+ ,"bigint"+ ,"binary"+ ,"blob"+ ,"boolean"+ ,"char"+ ,"character"+ ,"clob"+ ,"date"+ ,"dec"+ ,"decimal"+ ,"double"+ ,"float"+ ,"int"+ ,"integer"+ ,"nchar"+ ,"nclob"+ ,"numeric"+ ,"real"+ ,"smallint"+ ,"time"+ ,"timestamp"+ ,"varchar"+ ,"varbinary"+ ]
− Language/SQL/SimpleSQL/Dialect.lhs
@@ -1,540 +0,0 @@---Data types to represent different dialect options--> {-# LANGUAGE DeriveDataTypeable #-}-> module Language.SQL.SimpleSQL.Dialect-> (Dialect(..)-> ,ansi2011-> ,mysql-> ,postgres-> ,oracle-> ,sqlserver-> ) where--> import Data.Data--> -- | 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-> diKeywords :: [String]-> -- | keywords with identifier exception-> ,diIdentifierKeywords :: [String]-> -- | keywords with app exception-> ,diAppKeywords :: [String]-> -- | keywords with type exception plus all the type names which-> -- are multiple words-> ,diSpecialTypeNames :: [String]-> -- | allow ansi fetch first syntax-> ,diFetchFirst :: Bool-> -- | allow limit keyword (mysql, postgres,-> -- ...)-> ,diLimit :: Bool-> -- | allow parsing ODBC syntax-> ,diOdbc :: Bool-> -- | allow quoting identifiers with \`backquotes\`-> ,diBackquotedIden :: Bool-> -- | allow quoting identifiers with [square brackets]-> ,diSquareBracketQuotedIden :: Bool-> -- | allow identifiers with a leading at @example-> ,diAtIdentifier :: Bool-> -- | allow identifiers with a leading \# \#example-> ,diHashIdentifier :: Bool-> -- | allow positional identifiers like this: $1 -> ,diPositionalArg :: Bool-> -- | allow postgres style dollar strings-> ,diDollarString :: Bool-> -- | allow strings with an e - e"example"-> ,diEString :: Bool-> -- | allow postgres style symbols-> ,diPostgresSymbols :: Bool-> -- | allow sql server style symbols-> ,diSqlServerSymbols :: Bool-> }-> deriving (Eq,Show,Read,Data,Typeable)--> -- | ansi sql 2011 dialect-> ansi2011 :: Dialect-> ansi2011 = Dialect {diKeywords = ansi2011ReservedKeywords-> ,diIdentifierKeywords = []-> ,diAppKeywords = ["set"]-> ,diSpecialTypeNames = ansi2011TypeNames-> ,diFetchFirst = True-> ,diLimit = False-> ,diOdbc = False-> ,diBackquotedIden = False-> ,diSquareBracketQuotedIden = False-> ,diAtIdentifier = False-> ,diHashIdentifier = False-> ,diPositionalArg = False-> ,diDollarString = False-> ,diEString = False-> ,diPostgresSymbols = False-> ,diSqlServerSymbols = False-> }--> -- | mysql dialect-> mysql :: Dialect-> mysql = addLimit ansi2011 {diFetchFirst = False-> ,diBackquotedIden = True-> }--> -- | postgresql dialect-> postgres :: Dialect-> postgres = addLimit ansi2011 {diPositionalArg = True-> ,diDollarString = True-> ,diEString = True-> ,diPostgresSymbols = True}--> -- | oracle dialect-> oracle :: Dialect-> oracle = ansi2011 -- {}--> -- | microsoft sql server dialect-> sqlserver :: Dialect-> sqlserver = ansi2011 {diSquareBracketQuotedIden = True-> ,diAtIdentifier = True-> ,diHashIdentifier = True-> ,diSqlServerSymbols = True }--> addLimit :: Dialect -> Dialect-> addLimit d = 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 :: [String]-> ansi2011ReservedKeywords =-> [--"abs" -- function-> "all" -- keyword only?-> ,"allocate" -- keyword-> ,"alter" -- keyword-> ,"and" -- keyword-> --,"any" -- keyword? and function-> ,"are" -- keyword-> ,"array" -- keyword, and used in some special places, like array[...], and array(subquery)-> --,"array_agg" -- function-> -- ,"array_max_cardinality" -- function-> ,"as" -- keyword-> ,"asensitive" -- keyword-> ,"asymmetric" -- keyword-> ,"at" -- keyword-> ,"atomic" -- keyword-> ,"authorization" -- keyword-> --,"avg" -- function-> ,"begin" -- keyword-> --,"begin_frame" -- identifier-> --,"begin_partition" -- identifier-> ,"between" -- keyword-> ,"bigint" -- type-> ,"binary" -- type-> ,"blob" -- type-> ,"boolean" -- type-> ,"both" -- keyword-> ,"by" -- keyword-> ,"call" -- keyword-> ,"called" -- keyword-> -- ,"cardinality" -- function + identifier?-> ,"cascaded" -- keyword-> ,"case" -- keyword-> ,"cast" -- special function-> -- ,"ceil" -- function-> -- ,"ceiling" -- function-> ,"char" -- type (+ keyword?)-> --,"char_length" -- function-> ,"character" -- type-> --,"character_length" -- function-> ,"check" -- keyword-> ,"clob" -- type-> ,"close" -- keyword-> -- ,"coalesce" -- function-> ,"collate" -- keyword-> --,"collect" -- function-> ,"column" -- keyword-> ,"commit" -- keyword-> ,"condition" -- keyword-> ,"connect" -- keyword-> ,"constraint" --keyword-> --,"contains" -- keyword?-> --,"convert" -- function?-> --,"corr" -- function-> ,"corresponding" --keyword-> --,"count" --function-> --,"covar_pop" -- function-> --,"covar_samp" --function-> ,"create" -- keyword-> ,"cross" -- keyword-> ,"cube" -- keyword-> --,"cume_dist" -- function-> ,"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-> ,"cursor" -- keyword-> ,"cycle" --keyword-> ,"date" -- type-> --,"day" -- keyword? - the parser needs it to not be a keyword to parse extract at the moment-> ,"deallocate" -- keyword-> ,"dec" -- type-> ,"decimal" -- type-> ,"declare" -- keyword-> --,"default" -- identifier + keyword-> ,"delete" -- keyword-> --,"dense_rank" -- functino-> ,"deref" -- keyword-> ,"describe" -- keyword-> ,"deterministic"-> ,"disconnect"-> ,"distinct"-> ,"double"-> ,"drop"-> ,"dynamic"-> ,"each"-> --,"element"-> ,"else"-> ,"end"-> -- ,"end_frame" -- identifier-> -- ,"end_partition" -- identifier-> ,"end-exec" -- no idea what this is-> ,"equals"-> ,"escape"-> --,"every"-> ,"except"-> ,"exec"-> ,"execute"-> ,"exists"-> ,"exp"-> ,"external"-> ,"extract"-> --,"false"-> ,"fetch"-> ,"filter"-> -- ,"first_value"-> ,"float"-> --,"floor"-> ,"for"-> ,"foreign"-> -- ,"frame_row" -- identifier-> ,"free"-> ,"from"-> ,"full"-> ,"function"-> --,"fusion"-> ,"get"-> ,"global"-> ,"grant"-> ,"group"-> --,"grouping"-> ,"groups"-> ,"having"-> ,"hold"-> --,"hour"-> ,"identity"-> ,"in"-> ,"indicator"-> ,"inner"-> ,"inout"-> ,"insensitive"-> ,"insert"-> ,"int"-> ,"integer"-> ,"intersect"-> --,"intersection"-> ,"interval"-> ,"into"-> ,"is"-> ,"join"-> --,"lag"-> ,"language"-> ,"large"-> --,"last_value"-> ,"lateral"-> --,"lead"-> ,"leading"-> ,"left"-> ,"like"-> ,"like_regex"-> --,"ln"-> ,"local"-> ,"localtime"-> ,"localtimestamp"-> --,"lower"-> ,"match"-> --,"max"-> ,"member"-> ,"merge"-> ,"method"-> --,"min"-> --,"minute"-> --,"mod"-> ,"modifies"-> --,"module"-> --,"month"-> ,"multiset"-> ,"national"-> ,"natural"-> ,"nchar"-> ,"nclob"-> ,"new"-> ,"no"-> ,"none"-> ,"normalize"-> ,"not"-> --,"nth_value"-> ,"ntile"-> --,"null"-> --,"nullif"-> ,"numeric"-> ,"octet_length"-> ,"occurrences_regex"-> ,"of"-> ,"offset"-> ,"old"-> ,"on"-> ,"only"-> ,"open"-> ,"or"-> ,"order"-> ,"out"-> ,"outer"-> ,"over"-> ,"overlaps"-> ,"overlay"-> ,"parameter"-> ,"partition"-> ,"percent"-> --,"percent_rank"-> --,"percentile_cont"-> --,"percentile_disc"-> ,"period"-> ,"portion"-> ,"position"-> ,"position_regex"-> --,"power"-> ,"precedes"-> ,"precision"-> ,"prepare"-> ,"primary"-> ,"procedure"-> ,"range"-> --,"rank"-> ,"reads"-> ,"real"-> ,"recursive"-> ,"ref"-> ,"references"-> ,"referencing"-> --,"regr_avgx"-> --,"regr_avgy"-> --,"regr_count"-> --,"regr_intercept"-> --,"regr_r2"-> --,"regr_slope"-> --,"regr_sxx"-> --,"regr_sxy"-> --,"regr_syy"-> ,"release"-> ,"result"-> ,"return"-> ,"returns"-> ,"revoke"-> ,"right"-> ,"rollback"-> ,"rollup"-> --,"row"-> --,"row_number"-> ,"rows"-> ,"savepoint"-> ,"scope"-> ,"scroll"-> ,"search"-> --,"second"-> ,"select"-> ,"sensitive"-> --,"session_user"-> ,"set"-> ,"similar"-> ,"smallint"-> --,"some"-> ,"specific"-> ,"specifictype"-> ,"sql"-> ,"sqlexception"-> ,"sqlstate"-> ,"sqlwarning"-> --,"sqrt"-> --,"start"-> ,"static"-> --,"stddev_pop"-> --,"stddev_samp"-> ,"submultiset"-> --,"substring"-> ,"substring_regex"-> ,"succeeds"-> --,"sum"-> ,"symmetric"-> ,"system"-> --,"system_time"-> --,"system_user"-> ,"table"-> ,"tablesample"-> ,"then"-> ,"time"-> ,"timestamp"-> ,"timezone_hour"-> ,"timezone_minute"-> ,"to"-> ,"trailing"-> ,"translate"-> ,"translate_regex"-> ,"translation"-> ,"treat"-> ,"trigger"-> ,"truncate"-> --,"trim"-> --,"trim_array"-> --,"true"-> ,"uescape"-> ,"union"-> ,"unique"-> --,"unknown"-> ,"unnest"-> ,"update"-> ,"upper"-> --,"user"-> ,"using"-> --,"value"-> ,"values"-> ,"value_of"-> --,"var_pop"-> --,"var_samp"-> ,"varbinary"-> ,"varchar"-> ,"varying"-> ,"versioning"-> ,"when"-> ,"whenever"-> ,"where"-> --,"width_bucket"-> ,"window"-> ,"with"-> ,"within"-> ,"without"-> --,"year"-> ]---> ansi2011TypeNames :: [String]-> ansi2011TypeNames =-> ["double precision"-> ,"character varying"-> ,"char varying"-> ,"character large object"-> ,"char large object"-> ,"national character"-> ,"national char"-> ,"national character varying"-> ,"national char varying"-> ,"national character large object"-> ,"nchar large object"-> ,"nchar varying"-> ,"bit varying"-> ,"binary large object"-> ,"binary varying"-> -- reserved keyword typenames:-> ,"array"-> ,"bigint"-> ,"binary"-> ,"blob"-> ,"boolean"-> ,"char"-> ,"character"-> ,"clob"-> ,"date"-> ,"dec"-> ,"decimal"-> ,"double"-> ,"float"-> ,"int"-> ,"integer"-> ,"nchar"-> ,"nclob"-> ,"numeric"-> ,"real"-> ,"smallint"-> ,"time"-> ,"timestamp"-> ,"varchar"-> ,"varbinary"-> ]
− Language/SQL/SimpleSQL/Errors.lhs
@@ -1,51 +0,0 @@--> -- | helpers to work with parsec errors more nicely-> module Language.SQL.SimpleSQL.Errors-> (ParseError(..)-> --,formatError-> ,convParseError-> ) where--> import Text.Parsec (sourceColumn,sourceLine,sourceName,errorPos)-> import qualified Text.Parsec as P (ParseError)--> -- | Type to represent parse errors.-> data ParseError = ParseError-> {peErrorString :: String-> -- ^ contains the error message-> ,peFilename :: FilePath-> -- ^ filename location for the error-> ,pePosition :: (Int,Int)-> -- ^ line number and column number location for the error-> ,peFormattedError :: String-> -- ^ formatted error with the position, error-> -- message and source context-> } deriving (Eq,Show)--> convParseError :: String -> P.ParseError -> ParseError-> convParseError src e =-> ParseError-> {peErrorString = show e-> ,peFilename = sourceName p-> ,pePosition = (sourceLine p, sourceColumn p)-> ,peFormattedError = formatError src e}-> where-> p = errorPos e--format the error more nicely: emacs format for positioning, plus-context--> formatError :: String -> P.ParseError -> String-> formatError src e =-> sourceName p ++ ":" ++ show (sourceLine p)-> ++ ":" ++ show (sourceColumn p) ++ ":"-> ++ context-> ++ show e-> where-> context =-> let lns = take 1 $ drop (sourceLine p - 1) $ lines src-> in case lns of-> [x] -> "\n" ++ x ++ "\n"-> ++ replicate (sourceColumn p - 1) ' ' ++ "^\n"-> _ -> ""-> p = errorPos e
+ Language/SQL/SimpleSQL/Lex.hs view
@@ -0,0 +1,940 @@++{-+The parser uses a separate lexer for two reasons:++1. sql syntax is very awkward to parse, the separate lexer makes it+easier to handle this in most places (in some places it makes it+harder or impossible, the fix is to switch to something better than+parsec)++2. using a separate lexer gives a huge speed boost because it reduces+backtracking. (We could get this by making the parsing code a lot more+complex also.)++3. we can test the lexer relatively exhaustively, then even when we+don't do nearly as comprehensive testing on the syntax level, we still+have a relatively high assurance of the low level of bugs. This is+much more difficult to get parity with when testing the syntax parser+directly without the separately testing lexing stage.++TODO:++optimisations:++check for left factor opportunities+check for places where it parses a few substrings from the source,+ then puts them back together with a concatenate of some flavour+ -> this is better if can find a way to parse the entire string+ from the source and lift it in one go into the lexical token+before this is done, a smaller optimisation is when any code matches+ a constant string in the lexer, use that constant string instead+ of the string from the parser, it might make a small difference in+ a few places+maybe every token should carry the exact source as well as any fields+ it's been broken into - so pretty printing is trivial+++make the tokenswill print more dialect accurate. Maybe add symbol+ chars and identifier chars to the dialect definition and use them from+ here++start adding negative / different parse dialect tests++add token tables and tests for oracle, sql server+review existing tables++look for refactoring opportunities, especially the token+generation tables in the tests++do some user documentation on lexing, and lexing/dialects++start thinking about a more separated design for the dialect handling++lexing tests are starting to take a really long time, so split the+tests so it is much easier to run all the tests except the lexing+tests which only need to be run when working on the lexer (which+should be relatively uncommon), or doing a commit or finishing off a+series of commits,++start writing the error message tests:+ generate/write a large number of syntax errors+ create a table with the source and the error message+ try to compare some different versions of code to compare the+ quality of the error messages by hand++ get this checked in so improvements and regressions in the error+ message quality can be tracked a little more easily (although it will+ still be manual)++try again to add annotation to the ast++-}++-- | Lexer for SQL.+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++module Language.SQL.SimpleSQL.Lex+ (Token(..)+ ,WithPos(..)+ ,lexSQL+ ,lexSQLWithPositions+ ,prettyToken+ ,prettyTokens+ ,ParseError+ ,prettyError+ ,tokenListWillPrintAndLex+ ,ansi2011+ ,SQLStream(..)+ ) where++import Language.SQL.SimpleSQL.Dialect+ (Dialect(..)+ ,ansi2011+ )++import Text.Megaparsec+ (Parsec+ ,runParser'++ ,PosState(..)+ ,TraversableStream(..)+ ,VisualStream(..)+ + ,ParseErrorBundle(..)+ ,errorBundlePretty++ ,SourcePos(..)+ ,getSourcePos+ ,getOffset+ ,pstateSourcePos+ ,statePosState+ ,mkPos++ ,choice+ ,satisfy+ ,takeWhileP+ ,takeWhile1P+ ,(<?>)+ ,eof+ ,many+ ,try+ ,option+ ,(<|>)+ ,notFollowedBy+ ,manyTill+ ,anySingle+ ,lookAhead+ )+import qualified Text.Megaparsec as M+import Text.Megaparsec.Char+ (string+ ,char+ )+import Text.Megaparsec.State (initialState)++import qualified Data.List as DL+import qualified Data.List.NonEmpty as NE+import Data.Proxy (Proxy(..))+import Data.Void (Void)++import Control.Applicative ((<**>))+import Data.Char+ (isAlphaNum+ ,isAlpha+ ,isSpace+ ,isDigit+ )+import Control.Monad (void, guard)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Maybe (fromMaybe)++------------------------------------------------------------------------------++-- syntax++-- | Represents a lexed token+data Token+ -- | A symbol (in ansi dialect) is one of the following+ --+ -- * multi char symbols <> \<= \>= != ||+ -- * single char symbols: * + - < > ^ / % ~ & | ? ( ) [ ] , ; ( )+ --+ = Symbol Text+ -- | This is an identifier or keyword. The first field is+ -- the quotes used, or nothing if no quotes were used. The quotes+ -- can be " or u& or something dialect specific like []+ | Identifier (Maybe (Text,Text)) Text+ -- | This is a prefixed variable symbol, such as :var, @var or #var+ -- (only :var is used in ansi dialect)+ | PrefixedVariable Char Text+ -- | This is a positional arg identifier e.g. $1+ | PositionalArg Int+ -- | This is a string literal. The first two fields are the --+ -- start and end quotes, which are usually both ', but can be+ -- the character set (one of nNbBxX, or u&, U&), or a dialect+ -- specific string quoting (such as $$ in postgres)+ | SqlString Text Text Text+ -- | A number literal (integral or otherwise), stored in original format+ -- unchanged+ | SqlNumber Text+ -- | Whitespace, one or more of space, tab or newline.+ | Whitespace Text+ -- | A commented line using --, contains every character starting with the+ -- \'--\' and including the terminating newline character if there is one+ -- - this will be missing if the last line in the source is a line comment+ -- with no trailing newline+ | LineComment Text+ -- | A block comment, \/* stuff *\/, includes the comment delimiters+ | BlockComment Text+ deriving (Eq,Show,Ord)++------------------------------------------------------------------------------++-- main api functions++-- | Lex some SQL to a list of tokens.+lexSQLWithPositions+ :: Dialect+ -- ^ dialect of SQL to use+ -> Text+ -- ^ filename to use in error messages+ -> Maybe (Int,Int)+ -- ^ line number and column number of the first character+ -- in the source to use in error messages+ -> Text+ -- ^ the SQL source to lex+ -> Either ParseError [WithPos Token]+lexSQLWithPositions dialect fn p src = myParse fn p (many (sqlToken dialect) <* (eof <?> "")) src+++-- | Lex some SQL to a list of tokens.+lexSQL+ :: Dialect+ -- ^ dialect of SQL to use+ -> Text+ -- ^ filename to use in error messages+ -> Maybe (Int,Int)+ -- ^ line number and column number of the first character+ -- in the source to use in error messages+ -> Text+ -- ^ the SQL source to lex+ -> Either ParseError [Token]+lexSQL dialect fn p src =+ map tokenVal <$> lexSQLWithPositions dialect fn p src++myParse :: Text -> Maybe (Int,Int) -> Parser a -> Text -> Either ParseError a+myParse name sp' p s =+ let sp = fromMaybe (1,1) sp'+ ps = SourcePos (T.unpack name) (mkPos $ fst sp) (mkPos $ snd sp)+ is = initialState (T.unpack name) s+ sps = (statePosState is) {pstateSourcePos = ps}+ is' = is {statePosState = sps}+ in snd $ runParser' p is'++prettyError :: ParseError -> Text+prettyError = T.pack . errorBundlePretty++------------------------------------------------------------------------------++-- parsing boilerplate++type ParseError = ParseErrorBundle Text Void++type Parser = Parsec Void Text++-- | Positional information added to tokens to preserve source positions+-- for the parser+data WithPos a = WithPos+ { startPos :: SourcePos+ , endPos :: SourcePos+ , tokenLength :: Int+ , tokenVal :: a+ } deriving (Eq, Ord, Show)++------------------------------------------------------------------------------++-- pretty print++-- | Pretty printing, if you lex a bunch of tokens, then pretty+-- print them, should should get back exactly the same string+prettyToken :: Dialect -> Token -> Text+prettyToken _ (Symbol s) = s+prettyToken _ (Identifier Nothing t) = t+prettyToken _ (Identifier (Just (q1,q2)) t) = q1 <> t <> q2+prettyToken _ (PrefixedVariable c p) = T.cons c p+prettyToken _ (PositionalArg p) = T.cons '$' $ T.pack $ show p+prettyToken _ (SqlString s e t) = s <> t <> e+prettyToken _ (SqlNumber r) = r+prettyToken _ (Whitespace t) = t+prettyToken _ (LineComment l) = l+prettyToken _ (BlockComment c) = c++prettyTokens :: Dialect -> [Token] -> Text+prettyTokens d ts = T.concat $ map (prettyToken d) ts++------------------------------------------------------------------------------++-- token parsers++-- | parser for a sql token+sqlToken :: Dialect -> Parser (WithPos Token)+sqlToken d = (do+ -- possibly there's a more efficient way of doing the source positions?+ sp <- getSourcePos+ off <- getOffset+ t <- choice+ [sqlString d+ ,identifier d+ ,lineComment d+ ,blockComment d+ ,sqlNumber d+ ,positionalArg d+ ,dontParseEndBlockComment d+ ,prefixedVariable d+ ,symbol d+ ,sqlWhitespace d]+ off1 <- getOffset+ ep <- getSourcePos+ pure $ WithPos sp ep (off1 - off) t) <?> "valid lexical token"++--------------------------------------++{-+Parse a SQL string. Examples:++'basic string'+'string with '' a quote'+n'international text'+b'binary string'+x'hexidecimal string'+-}++sqlString :: Dialect -> Parser Token+sqlString d = dollarString <|> csString <|> normalString+ where+ dollarString = do+ guard $ diDollarString d+ -- use try because of ambiguity with symbols and with+ -- positional arg+ delim <- (\x -> T.concat ["$",x,"$"])+ <$> try (char '$' *> option "" identifierString <* char '$')+ SqlString delim delim . T.pack <$> manyTill anySingle (try $ string delim)+ normalString = SqlString "'" "'" <$> (char '\'' *> normalStringSuffix False "")+ normalStringSuffix allowBackslash t = do+ s <- takeWhileP Nothing $ if allowBackslash+ then (`notElemChar` "'\\")+ else (/= '\'')+ -- deal with '' or \' as literal quote character+ choice [do+ ctu <- choice ["''" <$ try (string "''")+ ,"\\'" <$ string "\\'"+ ,"\\" <$ char '\\']+ normalStringSuffix allowBackslash $ T.concat [t,s,ctu]+ ,T.concat [t,s] <$ char '\'']+ -- try is used to to avoid conflicts with+ -- identifiers which can start with n,b,x,u+ -- once we read the quote type and the starting '+ -- then we commit to a string+ -- it's possible that this will reject some valid syntax+ -- but only pathalogical stuff, and I think the improved+ -- error messages and user predictability make it a good+ -- pragmatic choice+ csString+ | diEString d =+ choice [SqlString <$> try (string "e'" <|> string "E'")+ <*> pure "'" <*> normalStringSuffix True ""+ ,csString']+ | otherwise = csString'+ csString' = SqlString+ <$> try cs+ <*> pure "'"+ <*> normalStringSuffix False ""+ csPrefixes = map (`T.cons` "'") "nNbBxX" ++ ["u&'", "U&'"]+ cs :: Parser Text+ cs = choice $ map string csPrefixes++--------------------------------------++{-+Parses identifiers:++simple_identifier_23+u&"unicode quoted identifier"+"quoted identifier"+"quoted identifier "" with double quote char"+`mysql quoted identifier`+-}++identifier :: Dialect -> Parser Token+identifier d =+ choice+ [quotedIden+ ,unicodeQuotedIden+ ,regularIden+ ,guard (diBackquotedIden d) >> mySqlQuotedIden+ ,guard (diSquareBracketQuotedIden d) >> sqlServerQuotedIden+ ]+ where+ regularIden = Identifier Nothing <$> identifierString+ quotedIden = Identifier (Just ("\"","\"")) <$> qidenPart+ mySqlQuotedIden = Identifier (Just ("`","`"))+ <$> (char '`' *> takeWhile1P Nothing (/='`') <* char '`')+ sqlServerQuotedIden = Identifier (Just ("[","]"))+ <$> (char '[' *> takeWhile1P Nothing (`notElemChar` "[]") <* char ']')+ -- try is used here to avoid a conflict with identifiers+ -- and quoted strings which also start with a 'u'+ unicodeQuotedIden = Identifier+ <$> (f <$> try (oneOf "uU" <* string "&"))+ <*> qidenPart+ where f x = Just (T.cons x "&\"", "\"")+ qidenPart = char '"' *> qidenSuffix ""+ qidenSuffix t = do+ s <- takeWhileP Nothing (/='"')+ void $ char '"'+ -- deal with "" as literal double quote character+ choice [do+ void $ char '"'+ qidenSuffix $ T.concat [t,s,"\"\""]+ ,pure $ T.concat [t,s]]++identifierString :: Parser Text+identifierString = (do+ c <- satisfy isFirstLetter+ choice+ [T.cons c <$> takeWhileP (Just "identifier char") isIdentifierChar+ ,pure $ T.singleton c]) <?> "identifier"+ where+ isFirstLetter c = c == '_' || isAlpha c++isIdentifierChar :: Char -> Bool+isIdentifierChar c = c == '_' || isAlphaNum c++--------------------------------------++lineComment :: Dialect -> Parser Token+lineComment _ = do+ try (string_ "--") <?> ""+ rest <- takeWhileP (Just "non newline character") (/='\n')+ -- can you optionally read the \n to terminate the takewhilep without reparsing it?+ suf <- option "" ("\n" <$ char_ '\n')+ pure $ LineComment $ T.concat ["--", rest, suf]++--------------------------------------++-- TODO: the parser before the switch to megaparsec parsed nested block comments+-- I don't know any dialects that use this, but I think it's useful, if needed,+-- add it back in under a dialect flag?+blockComment :: Dialect -> Parser Token+blockComment _ = (do+ try $ string_ "/*"+ BlockComment . T.concat . ("/*":) <$> more) <?> ""+ where+ more = choice+ [["*/"] <$ try (string_ "*/") -- comment ended+ ,char_ '*' *> (("*":) <$> more) -- comment contains * but this isn't the comment end token+ -- not sure if there's an easy optimisation here+ ,(:) <$> takeWhile1P (Just "non comment terminator text") (/= '*') <*> more]++{-+This is to improve user experience: provide an error if we see */+outside a comment. This could potentially break postgres ops with */+in them (which is a stupid thing to do). In other cases, the user+should write * / instead (I can't think of any cases when this would+be valid syntax though).+-}++dontParseEndBlockComment :: Dialect -> Parser Token+dontParseEndBlockComment _ =+ -- don't use try, then it should commit to the error+ try (string "*/") *> fail "comment end without comment start"++--------------------------------------++{-+numbers++digits+digits.[digits][e[+-]digits]+[digits].digits[e[+-]digits]+digitse[+-]digits++where digits is one or more decimal digits (0 through 9). At least one+digit must be before or after the decimal point, if one is used. At+least one digit must follow the exponent marker (e), if one is+present. There cannot be any spaces or other characters embedded in+the constant. Note that any leading plus or minus sign is not actually+considered part of the constant; it is an operator applied to the+constant.+++algorithm:+either+ parse 1 or more digits+ then an optional dot which isn't two dots+ then optional digits+ or: parse a dot which isn't two dots+ then digits+followed by an optional exponent+-}++sqlNumber :: Dialect -> Parser Token+sqlNumber d =+ SqlNumber <$> completeNumber+ -- this is for definitely avoiding possibly ambiguous source+ <* choice [-- special case to allow e.g. 1..2+ guard (diPostgresSymbols d)+ *> void (lookAhead $ try (string ".." <?> ""))+ <|> void (notFollowedBy (oneOf "eE."))+ ,notFollowedBy (oneOf "eE.")+ ]+ where+ completeNumber =+ (digits <??> (pp dot <??.> pp digits)+ -- try is used in case we read a dot+ -- and it isn't part of a number+ -- if there are any following digits, then we commit+ -- to it being a number and not something else+ <|> try ((<>) <$> dot <*> digits))+ <??> pp expon++ -- make sure we don't parse two adjacent dots in a number+ -- special case for postgresql, we backtrack if we see two adjacent dots+ -- to parse 1..2, but in other dialects we commit to the failure+ dot = let p = string "." <* notFollowedBy (char '.')+ in if diPostgresSymbols d+ then try p+ else p+ expon = T.cons <$> oneOf "eE" <*> sInt+ sInt = (<>) <$> option "" (T.singleton <$> oneOf "+-") <*> digits+ pp = (<$$> (<>))+ p <??> q = p <**> option id q+ pa <$$> c = pa <**> pure (flip c)+ pa <??.> pb =+ let c = (<$>) . flip+ in (.) `c` pa <*> option id pb++digits :: Parser Text+digits = takeWhile1P (Just "digit") isDigit++--------------------------------------++positionalArg :: Dialect -> Parser Token+positionalArg d =+ guard (diPositionalArg d) >>+ -- use try to avoid ambiguities with other syntax which starts with dollar+ PositionalArg <$> try (char_ '$' *> (read . T.unpack <$> digits))++--------------------------------------++-- todo: I think the try here should read a prefix char, then a single valid+-- identifier char, then commit+prefixedVariable :: Dialect -> Parser Token+prefixedVariable d = try $ choice+ [PrefixedVariable <$> char ':' <*> identifierString+ ,guard (diAtIdentifier d) >>+ PrefixedVariable <$> char '@' <*> identifierString+ ,guard (diHashIdentifier d) >>+ PrefixedVariable <$> char '#' <*> identifierString+ ]++--------------------------------------++{-+Symbols++A symbol is an operator, or one of the misc symbols which include:+. .. := : :: ( ) ? ; , { } (for odbc)++The postgresql operator syntax allows a huge range of operators+compared with ansi and other dialects+-}++symbol :: Dialect -> Parser Token+symbol d = Symbol <$> choice (concat+ [dots+ ,if diPostgresSymbols d+ then postgresExtraSymbols+ else []+ ,miscSymbol+ ,if diOdbc d then odbcSymbol else []+ ,if diPostgresSymbols d+ then generalizedPostgresqlOperator+ else basicAnsiOps+ ])+ where+ dots = [takeWhile1P (Just "dot") (=='.')]+ odbcSymbol = [string "{", string "}"]+ postgresExtraSymbols =+ [try (string ":=")+ -- parse :: and : and avoid allowing ::: or more+ ,try (string "::" <* notFollowedBy (char ':'))+ ,try (string ":" <* notFollowedBy (char ':'))]+ miscSymbol = map (string . T.singleton) $+ case () of+ _ | diSqlServerSymbols d -> ",;():?"+ | diPostgresSymbols d -> "[],;()"+ | otherwise -> "[],;():?"++{-+try is used because most of the first characters of the two character+symbols can also be part of a single character symbol+-}++ basicAnsiOps = map (try . string) [">=","<=","!=","<>"]+ ++ map (string . T.singleton) "+-^*/%~&<>="+ ++ pipes+ pipes = -- what about using many1 (char '|'), then it will+ -- fail in the parser? Not sure exactly how+ -- standalone the lexer should be+ [char '|' *>+ choice ["||" <$ char '|' <* notFollowedBy (char '|')+ ,pure "|"]]++{-+postgresql generalized operators++this includes the custom operators that postgres supports,+plus all the standard operators which could be custom operators+according to their grammar++rules++An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:+++ - * / < > = ~ ! @ # % ^ & | ` ?++There are a few restrictions on operator names, however:+-- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.++A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:++~ ! @ # % ^ & | ` ?++which allows the last character of a multi character symbol to be + or+-+-}++generalizedPostgresqlOperator :: [Parser Text]+generalizedPostgresqlOperator = [singlePlusMinus,opMoreChars]+ where+ allOpSymbols = "+-*/<>=~!@#%^&|`?"+ -- these are the symbols when if part of a multi character+ -- operator permit the operator to end with a + or - symbol+ exceptionOpSymbols = "~!@#%^&|`?"++ -- special case for parsing a single + or - symbol+ singlePlusMinus = try $ do+ c <- oneOf "+-"+ notFollowedBy $ oneOf allOpSymbols+ pure $ T.singleton c++ -- this is used when we are parsing a potentially multi symbol+ -- operator and we have alread seen one of the 'exception chars'+ -- and so we can end with a + or -+ moreOpCharsException = do+ c <- oneOf (filter (`notElemChar` "-/*") allOpSymbols)+ -- make sure we don't parse a comment starting token+ -- as part of an operator+ <|> try (char '/' <* notFollowedBy (char '*'))+ <|> try (char '-' <* notFollowedBy (char '-'))+ -- and make sure we don't parse a block comment end+ -- as part of another symbol+ <|> try (char '*' <* notFollowedBy (char '/'))+ T.cons c <$> option "" moreOpCharsException++ opMoreChars = choice+ [-- parse an exception char, now we can finish with a + -+ T.cons+ <$> oneOf exceptionOpSymbols+ <*> option "" moreOpCharsException+ ,T.cons+ <$> (-- parse +, make sure it isn't the last symbol+ try (char '+' <* lookAhead (oneOf allOpSymbols))+ <|> -- parse -, make sure it isn't the last symbol+ -- or the start of a -- comment+ try (char '-'+ <* notFollowedBy (char '-')+ <* lookAhead (oneOf allOpSymbols))+ <|> -- parse / check it isn't the start of a /* comment+ try (char '/' <* notFollowedBy (char '*'))+ <|> -- make sure we don't parse */ as part of a symbol+ try (char '*' <* notFollowedBy (char '/'))+ <|> -- any other ansi operator symbol+ oneOf "<>=")+ <*> option "" opMoreChars+ ]++--------------------------------------++sqlWhitespace :: Dialect -> Parser Token+sqlWhitespace _ = Whitespace <$> takeWhile1P (Just "whitespace") isSpace <?> ""++----------------------------------------------------------------------------++-- parser helpers++char_ :: Char -> Parser ()+char_ = void . char++string_ :: Text -> Parser ()+string_ = void . string++oneOf :: [Char] -> Parser Char+oneOf = M.oneOf++notElemChar :: Char -> [Char] -> Bool+notElemChar a b = a `notElem` (b :: [Char])++----------------------------------------------------------------------------+++{-+This utility function will accurately report if the two tokens are+pretty printed, if they should lex back to the same two tokens. This+function is used in testing (and can be used in other places), and+must not be implemented by actually trying to print both tokens and+then lex them back from a single string (because then we would have+the risk of thinking two tokens cannot be together when there is bug+in the lexer, which the testing is supposed to find).++maybe do some quick checking to make sure this function only gives+true negatives: check pairs which return false actually fail to lex or+give different symbols in return: could use quickcheck for this++a good sanity test for this function is to change it to always return+true, then check that the automated tests return the same number of+successes. I don't think it succeeds this test at the moment+-}++-- | Utility function to tell you if a list of tokens+-- will pretty print then lex back to the same set of tokens.+-- Used internally, might be useful for generating SQL via lexical tokens.+tokenListWillPrintAndLex :: Dialect -> [Token] -> Bool+tokenListWillPrintAndLex _ [] = True+tokenListWillPrintAndLex _ [_] = True+tokenListWillPrintAndLex d (a:b:xs) =+ tokensWillPrintAndLex d a b && tokenListWillPrintAndLex d (b:xs)++tokensWillPrintAndLex :: Dialect -> Token -> Token -> Bool+tokensWillPrintAndLex d a b++{-+a : followed by an identifier character will look like a host param+followed by = or : makes a different symbol+-}++ | Symbol ":" <- a+ , checkFirstBChar (\x -> isIdentifierChar x || x `T.elem` ":=") = False++{-+two symbols next to eachother will fail if the symbols can combine and+(possibly just the prefix) look like a different symbol+-}++ | diPostgresSymbols d+ , Symbol a' <- a+ , Symbol b' <- b+ , b' `notElem` ["+", "-"] || any (`T.elem` a') ("~!@#%^&|`?" :: [Char]) = False++{-+check two adjacent symbols in non postgres where the combination+possibilities are much more limited. This is ansi behaviour, it might+be different when the other dialects are done properly+-}++ | Symbol a' <- a+ , Symbol b' <- b+ , (a',b') `elem` [("<",">")+ ,("<","=")+ ,(">","=")+ ,("!","=")+ ,("|","|")+ ,("||","|")+ ,("|","||")+ ,("||","||")+ ,("<",">=")+ ] = False++-- two whitespaces will be combined++ | Whitespace {} <- a+ , Whitespace {} <- b = False++-- line comment without a newline at the end will eat the next token++ | LineComment {} <- a+ , checkLastAChar (/='\n') = False++{-+check the last character of the first token and the first character of+the second token forming a comment start or end symbol+-}++ | let f '-' '-' = True+ f '/' '*' = True+ f '*' '/' = True+ f _ _ = False+ in checkBorderChars f = False++{-+a symbol will absorb a following .+TODO: not 100% on this always being bad+-}++ | Symbol {} <- a+ , checkFirstBChar (=='.') = False++-- cannot follow a symbol ending in : with another token starting with :++ | let f ':' ':' = True+ f _ _ = False+ in checkBorderChars f = False++-- unquoted identifier followed by an identifier letter++ | Identifier Nothing _ <- a+ , checkFirstBChar isIdentifierChar = False++-- a quoted identifier using ", followed by a " will fail++ | Identifier (Just (_,"\"")) _ <- a+ , checkFirstBChar (=='"') = False++-- prefixed variable followed by an identifier char will be absorbed++ | PrefixedVariable {} <- a+ , checkFirstBChar isIdentifierChar = False++-- a positional arg will absorb a following digit++ | PositionalArg {} <- a+ , checkFirstBChar isDigit = False++-- a string ending with ' followed by a token starting with ' will be absorbed++ | SqlString _ "'" _ <- a+ , checkFirstBChar (=='\'') = False++-- a number followed by a . will fail or be absorbed++ | SqlNumber {} <- a+ , checkFirstBChar (=='.') = False++-- a number followed by an e or E will fail or be absorbed++ | SqlNumber {} <- a+ , checkFirstBChar (\x -> x =='e' || x == 'E') = False++-- two numbers next to eachother will fail or be absorbed++ | SqlNumber {} <- a+ , SqlNumber {} <- b = False+++ | otherwise = True++ where+ prettya = prettyToken d a+ prettyb = prettyToken d b+ -- helper function to run a predicate on the+ -- last character of the first token and the first+ -- character of the second token+ checkBorderChars f =+ case (T.unsnoc prettya, T.uncons prettyb) of+ (Just (_,la), Just (fb,_)) -> f la fb+ _ -> False+ checkFirstBChar f = case T.uncons prettyb of+ Just (b',_) -> f b'+ _ -> False+ checkLastAChar f = case T.unsnoc prettya of+ Just (_,la) -> f la+ _ -> False++------------------------------------------------------------------------------++-- megaparsec stream boilerplate++-- | Wrapper to allow using the lexer as input to a megaparsec parser.+data SQLStream = SQLStream+ { sqlStreamInput :: String+ , unSQLStream :: [WithPos Token]+ }++instance M.Stream SQLStream where+ type Token SQLStream = WithPos Token+ type Tokens SQLStream = [WithPos Token]++ tokenToChunk Proxy x = [x]+ tokensToChunk Proxy xs = xs+ chunkToTokens Proxy = id+ chunkLength Proxy = length+ chunkEmpty Proxy = null+ take1_ (SQLStream _ []) = Nothing+ take1_ (SQLStream str (t:ts)) = Just+ ( t+ , SQLStream (drop (tokensLength pxy (t NE.:|[])) str) ts+ )+ takeN_ n (SQLStream str s)+ | n <= 0 = Just ([], SQLStream str s)+ | null s = Nothing+ | otherwise =+ let (x, s') = splitAt n s+ in case NE.nonEmpty x of+ Nothing -> Just (x, SQLStream str s')+ Just nex -> Just (x, SQLStream (drop (tokensLength pxy nex) str) s')+ takeWhile_ f (SQLStream str s) =+ let (x, s') = DL.span f s+ in case NE.nonEmpty x of+ Nothing -> (x, SQLStream str s')+ Just nex -> (x, SQLStream (drop (tokensLength pxy nex) str) s')++instance VisualStream SQLStream where+ showTokens Proxy = DL.intercalate " "+ . NE.toList+ . fmap (showMyToken . tokenVal)+ tokensLength Proxy xs = sum (tokenLength <$> xs)++instance TraversableStream SQLStream where+ reachOffset o M.PosState {..} =+ ( Just (prefix ++ restOfLine)+ , PosState+ { pstateInput = SQLStream+ { sqlStreamInput = postStr+ , unSQLStream = post+ }+ , pstateOffset = max pstateOffset o+ , pstateSourcePos = newSourcePos+ , pstateTabWidth = pstateTabWidth+ , pstateLinePrefix = prefix+ }+ )+ where+ prefix =+ if sameLine+ then pstateLinePrefix ++ preLine+ else preLine+ sameLine = sourceLine newSourcePos == sourceLine pstateSourcePos+ newSourcePos =+ case post of+ [] -> case unSQLStream pstateInput of+ [] -> pstateSourcePos+ xs -> endPos (last xs)+ (x:_) -> startPos x+ (pre, post) = splitAt (o - pstateOffset) (unSQLStream pstateInput)+ (preStr, postStr) = splitAt tokensConsumed (sqlStreamInput pstateInput)+ preLine = reverse . takeWhile (/= '\n') . reverse $ preStr+ tokensConsumed =+ case NE.nonEmpty pre of+ Nothing -> 0+ Just nePre -> tokensLength pxy nePre+ restOfLine = takeWhile (/= '\n') postStr++pxy :: Proxy SQLStream+pxy = Proxy++showMyToken :: Token -> String+-- todo: how to do this properly?+showMyToken = T.unpack . prettyToken ansi2011
− Language/SQL/SimpleSQL/Lex.lhs
@@ -1,717 +0,0 @@--The parser uses a separate lexer for two reasons:--1. sql syntax is very awkward to parse, the separate lexer makes it-easier to handle this in most places (in some places it makes it-harder or impossible, the fix is to switch to something better than-parsec)--2. using a separate lexer gives a huge speed boost because it reduces-backtracking. (We could get this by making the parsing code a lot more-complex also.)--3. we can test the lexer relatively exhaustively, then even when we-don't do nearly as comprehensive testing on the syntax level, we still-have a relatively high assurance of the low level of bugs. This is-much more difficult to get parity with when testing the syntax parser-directly without the separately testing lexing stage.--> -- | Lexer for SQL.-> {-# LANGUAGE TupleSections #-}-> module Language.SQL.SimpleSQL.Lex-> (Token(..)-> ,lexSQL-> ,prettyToken-> ,prettyTokens-> ,ParseError(..)-> ,tokenListWillPrintAndLex-> ,ansi2011-> ) where--> import Language.SQL.SimpleSQL.Dialect--> import Text.Parsec (option,string,manyTill,anyChar-> ,try,string,many1,oneOf,digit,(<|>),choice,char,eof-> ,many,runParser,lookAhead,satisfy-> ,setPosition,getPosition-> ,setSourceColumn,setSourceLine-> ,sourceName, setSourceName-> ,sourceLine, sourceColumn-> ,notFollowedBy)-> import Language.SQL.SimpleSQL.Combinators-> import Language.SQL.SimpleSQL.Errors-> import Control.Applicative hiding ((<|>), many)-> import Data.Char-> import Control.Monad-> import Prelude hiding (takeWhile)-> import Text.Parsec.String (Parser)-> import Data.Maybe---> -- | Represents a lexed token-> data Token-> -- | A symbol (in ansi dialect) is one of the following-> ---> -- * multi char symbols <> \<= \>= != ||-> -- * single char symbols: * + - < > ^ / % ~ & | ? ( ) [ ] , ; ( )-> ---> = Symbol String->-> -- | This is an identifier or keyword. The first field is-> -- the quotes used, or nothing if no quotes were used. The quotes-> -- can be " or u& or something dialect specific like []-> | Identifier (Maybe (String,String)) String->-> -- | This is a prefixed variable symbol, such as :var, @var or #var-> -- (only :var is used in ansi dialect)-> | PrefixedVariable Char String->-> -- | This is a positional arg identifier e.g. $1-> | PositionalArg Int->-> -- | This is a string literal. The first two fields are the ---> -- start and end quotes, which are usually both ', but can be-> -- the character set (one of nNbBxX, or u&, U&), or a dialect-> -- specific string quoting (such as $$ in postgres)-> | SqlString String String String->-> -- | A number literal (integral or otherwise), stored in original format-> -- unchanged-> | SqlNumber String->-> -- | Whitespace, one or more of space, tab or newline.-> | Whitespace String->-> -- | A commented line using --, contains every character starting with the-> -- \'--\' and including the terminating newline character if there is one-> -- - this will be missing if the last line in the source is a line comment-> -- with no trailing newline-> | LineComment String->-> -- | A block comment, \/* stuff *\/, includes the comment delimiters-> | BlockComment String->-> deriving (Eq,Show)----> -- | Pretty printing, if you lex a bunch of tokens, then pretty-> -- print them, should should get back exactly the same string-> prettyToken :: Dialect -> Token -> String-> prettyToken _ (Symbol s) = s-> prettyToken _ (Identifier Nothing t) = t-> prettyToken _ (Identifier (Just (q1,q2)) t) = q1 ++ t ++ q2-> prettyToken _ (PrefixedVariable c p) = c:p-> prettyToken _ (PositionalArg p) = '$':show p-> prettyToken _ (SqlString s e t) = s ++ t ++ e-> prettyToken _ (SqlNumber r) = r-> prettyToken _ (Whitespace t) = t-> prettyToken _ (LineComment l) = l-> prettyToken _ (BlockComment c) = c--> prettyTokens :: Dialect -> [Token] -> String-> prettyTokens d ts = concat $ map (prettyToken d) ts--TODO: try to make all parsers applicative only--> -- | Lex some SQL to a list of tokens.-> lexSQL :: Dialect-> -- ^ dialect of SQL to use-> -> FilePath-> -- ^ filename to use in error messages-> -> Maybe (Int,Int)-> -- ^ line number and column number of the first character-> -- in the source to use in error messages-> -> String-> -- ^ the SQL source to lex-> -> Either ParseError [((String,Int,Int),Token)]-> lexSQL dialect fn' p src =-> let (l',c') = fromMaybe (1,1) p-> in either (Left . convParseError src) Right-> $ runParser (setPos (fn',l',c') *> many (sqlToken dialect) <* eof) () fn' src-> where-> setPos (fn,l,c) = do-> fmap (flip setSourceName fn-> . flip setSourceLine l-> . flip setSourceColumn c) getPosition-> >>= setPosition--> -- | parser for a sql token-> sqlToken :: Dialect -> Parser ((String,Int,Int),Token)-> sqlToken d = do-> p' <- getPosition-> let p = (sourceName p',sourceLine p', sourceColumn p')--The order of parsers is important: strings and quoted identifiers can-start out looking like normal identifiers, so we try to parse these-first and use a little bit of try. Line and block comments start like-symbols, so we try these before symbol. Numbers can start with a . so-this is also tried before symbol (a .1 will be parsed as a number, but-. otherwise will be parsed as a symbol).--> (p,) <$> choice [sqlString d-> ,identifier d-> ,lineComment d-> ,blockComment d-> ,sqlNumber d-> ,positionalArg d-> ,dontParseEndBlockComment d-> ,prefixedVariable d-> ,symbol d-> ,sqlWhitespace d]--Parses identifiers:--simple_identifier_23-u&"unicode quoted identifier"-"quoted identifier"-"quoted identifier "" with double quote char"-`mysql quoted identifier`--> identifier :: Dialect -> Parser Token-> identifier d =-> choice-> [quotedIden-> ,unicodeQuotedIden-> ,regularIden-> ,guard (diBackquotedIden d) >> mySqlQuotedIden-> ,guard (diSquareBracketQuotedIden d) >> sqlServerQuotedIden-> ]-> where-> regularIden = Identifier Nothing <$> identifierString-> quotedIden = Identifier (Just ("\"","\"")) <$> qidenPart-> mySqlQuotedIden = Identifier (Just ("`","`"))-> <$> (char '`' *> takeWhile1 (/='`') <* char '`')-> sqlServerQuotedIden = Identifier (Just ("[","]"))-> <$> (char '[' *> takeWhile1 (`notElem` "[]") <* char ']')-> -- try is used here to avoid a conflict with identifiers-> -- and quoted strings which also start with a 'u'-> unicodeQuotedIden = Identifier-> <$> (f <$> try (oneOf "uU" <* string "&"))-> <*> qidenPart-> where f x = Just (x: "&\"", "\"")-> qidenPart = char '"' *> qidenSuffix ""-> qidenSuffix t = do-> s <- takeTill (=='"')-> void $ char '"'-> -- deal with "" as literal double quote character-> choice [do-> void $ char '"'-> qidenSuffix $ concat [t,s,"\"\""]-> ,return $ concat [t,s]]---This parses a valid identifier without quotes.--> identifierString :: Parser String-> identifierString =-> startsWith (\c -> c == '_' || isAlpha c) isIdentifierChar--this can be moved to the dialect at some point--> isIdentifierChar :: Char -> Bool-> isIdentifierChar c = c == '_' || isAlphaNum c--use try because : and @ can be part of other things also--> prefixedVariable :: Dialect -> Parser Token-> prefixedVariable d = try $ choice-> [PrefixedVariable <$> char ':' <*> identifierString-> ,guard (diAtIdentifier d) >>-> PrefixedVariable <$> char '@' <*> identifierString-> ,guard (diHashIdentifier d) >>-> PrefixedVariable <$> char '#' <*> identifierString-> ]--> positionalArg :: Dialect -> Parser Token-> positionalArg d =-> guard (diPositionalArg d) >>-> -- use try to avoid ambiguities with other syntax which starts with dollar-> PositionalArg <$> try (char '$' *> (read <$> many1 digit))---Parse a SQL string. Examples:--'basic string'-'string with '' a quote'-n'international text'-b'binary string'-x'hexidecimal string'---> sqlString :: Dialect -> Parser Token-> sqlString d = dollarString <|> csString <|> normalString-> where-> dollarString = do-> guard $ diDollarString d-> -- use try because of ambiguity with symbols and with-> -- positional arg-> delim <- (\x -> concat ["$",x,"$"])-> <$> try (char '$' *> option "" identifierString <* char '$')-> SqlString delim delim <$> manyTill anyChar (try $ string delim)-> normalString = SqlString "'" "'" <$> (char '\'' *> normalStringSuffix False "")-> normalStringSuffix allowBackslash t = do-> s <- takeTill $ if allowBackslash-> then (`elem` "'\\")-> else (== '\'')-> -- deal with '' or \' as literal quote character-> choice [do-> ctu <- choice ["''" <$ try (string "''")-> ,"\\'" <$ string "\\'"-> ,"\\" <$ char '\\']-> normalStringSuffix allowBackslash $ concat [t,s,ctu]-> ,concat [t,s] <$ char '\'']-> -- try is used to to avoid conflicts with-> -- identifiers which can start with n,b,x,u-> -- once we read the quote type and the starting '-> -- then we commit to a string-> -- it's possible that this will reject some valid syntax-> -- but only pathalogical stuff, and I think the improved-> -- error messages and user predictability make it a good-> -- pragmatic choice-> csString-> | diEString d =-> choice [SqlString <$> try (string "e'" <|> string "E'")-> <*> return "'" <*> normalStringSuffix True ""-> ,csString']-> | otherwise = csString'-> csString' = SqlString-> <$> try cs-> <*> return "'"-> <*> normalStringSuffix False ""-> csPrefixes = "nNbBxX"-> cs = choice $ (map (\x -> string ([x] ++ "'")) csPrefixes)-> ++ [string "u&'"-> ,string "U&'"]--numbers--digits-digits.[digits][e[+-]digits]-[digits].digits[e[+-]digits]-digitse[+-]digits--where digits is one or more decimal digits (0 through 9). At least one-digit must be before or after the decimal point, if one is used. At-least one digit must follow the exponent marker (e), if one is-present. There cannot be any spaces or other characters embedded in-the constant. Note that any leading plus or minus sign is not actually-considered part of the constant; it is an operator applied to the-constant.--> sqlNumber :: Dialect -> Parser Token-> sqlNumber d =-> SqlNumber <$> completeNumber-> -- this is for definitely avoiding possibly ambiguous source-> <* choice [-- special case to allow e.g. 1..2-> guard (diPostgresSymbols d)-> *> (void $ lookAhead $ try $ string "..")-> <|> void (notFollowedBy (oneOf "eE."))-> ,notFollowedBy (oneOf "eE.")-> ]-> where-> completeNumber =-> (int <??> (pp dot <??.> pp int)-> -- try is used in case we read a dot-> -- and it isn't part of a number-> -- if there are any following digits, then we commit-> -- to it being a number and not something else-> <|> try ((++) <$> dot <*> int))-> <??> pp expon--> int = many1 digit-> -- make sure we don't parse two adjacent dots in a number-> -- special case for postgresql, we backtrack if we see two adjacent dots-> -- to parse 1..2, but in other dialects we commit to the failure-> dot = let p = string "." <* notFollowedBy (char '.')-> in if diPostgresSymbols d-> then try p-> else p-> expon = (:) <$> oneOf "eE" <*> sInt-> sInt = (++) <$> option "" (string "+" <|> string "-") <*> int-> pp = (<$$> (++))--Symbols--A symbol is an operator, or one of the misc symbols which include:-. .. := : :: ( ) ? ; , { } (for odbc)--The postgresql operator syntax allows a huge range of operators-compared with ansi and other dialects--> symbol :: Dialect -> Parser Token-> symbol d = Symbol <$> choice (concat-> [dots-> ,if diPostgresSymbols d-> then postgresExtraSymbols-> else []-> ,miscSymbol-> ,if diOdbc d then odbcSymbol else []-> ,if diPostgresSymbols d-> then generalizedPostgresqlOperator-> else basicAnsiOps-> ])-> where-> dots = [many1 (char '.')]-> odbcSymbol = [string "{", string "}"]-> postgresExtraSymbols =-> [try (string ":=")-> -- parse :: and : and avoid allowing ::: or more-> ,try (string "::" <* notFollowedBy (char ':'))-> ,try (string ":" <* notFollowedBy (char ':'))]-> miscSymbol = map (string . (:[])) $-> case () of-> _ | diSqlServerSymbols d -> ",;():?"-> | diPostgresSymbols d -> "[],;()"-> | otherwise -> "[],;():?"--try is used because most of the first characters of the two character-symbols can also be part of a single character symbol--> basicAnsiOps = map (try . string) [">=","<=","!=","<>"]-> ++ map (string . (:[])) "+-^*/%~&<>="-> ++ pipes-> pipes = -- what about using many1 (char '|'), then it will-> -- fail in the parser? Not sure exactly how-> -- standalone the lexer should be-> [char '|' *>-> choice ["||" <$ char '|' <* notFollowedBy (char '|')-> ,return "|"]]--postgresql generalized operators--this includes the custom operators that postgres supports,-plus all the standard operators which could be custom operators-according to their grammar--rules--An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:--+ - * / < > = ~ ! @ # % ^ & | ` ?--There are a few restrictions on operator names, however:--- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.--A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:--~ ! @ # % ^ & | ` ?--which allows the last character of a multi character symbol to be + or----> generalizedPostgresqlOperator :: [Parser String]-> generalizedPostgresqlOperator = [singlePlusMinus,opMoreChars]-> where-> allOpSymbols = "+-*/<>=~!@#%^&|`?"-> -- these are the symbols when if part of a multi character-> -- operator permit the operator to end with a + or - symbol-> exceptionOpSymbols = "~!@#%^&|`?"--> -- special case for parsing a single + or - symbol-> singlePlusMinus = try $ do-> c <- oneOf "+-"-> notFollowedBy $ oneOf allOpSymbols-> return [c]--> -- this is used when we are parsing a potentially multi symbol-> -- operator and we have alread seen one of the 'exception chars'-> -- and so we can end with a + or --> moreOpCharsException = do-> c <- oneOf (filter (`notElem` "-/*") allOpSymbols)-> -- make sure we don't parse a comment starting token-> -- as part of an operator-> <|> try (char '/' <* notFollowedBy (char '*'))-> <|> try (char '-' <* notFollowedBy (char '-'))-> -- and make sure we don't parse a block comment end-> -- as part of another symbol-> <|> try (char '*' <* notFollowedBy (char '/'))-> (c:) <$> option [] moreOpCharsException--> opMoreChars = choice-> [-- parse an exception char, now we can finish with a + --> (:)-> <$> oneOf exceptionOpSymbols-> <*> option [] moreOpCharsException-> ,(:)-> <$> (-- parse +, make sure it isn't the last symbol-> try (char '+' <* lookAhead (oneOf allOpSymbols))-> <|> -- parse -, make sure it isn't the last symbol-> -- or the start of a -- comment-> try (char '-'-> <* notFollowedBy (char '-')-> <* lookAhead (oneOf allOpSymbols))-> <|> -- parse / check it isn't the start of a /* comment-> try (char '/' <* notFollowedBy (char '*'))-> <|> -- make sure we don't parse */ as part of a symbol-> try (char '*' <* notFollowedBy (char '/'))-> <|> -- any other ansi operator symbol-> oneOf "<>=")-> <*> option [] opMoreChars-> ]--> sqlWhitespace :: Dialect -> Parser Token-> sqlWhitespace _ = Whitespace <$> many1 (satisfy isSpace)--> lineComment :: Dialect -> Parser Token-> lineComment _ =-> (\s -> LineComment $ concat ["--",s]) <$>-> -- try is used here in case we see a - symbol-> -- once we read two -- then we commit to the comment token-> (try (string "--") *> (-> -- todo: there must be a better way to do this-> conc <$> manyTill anyChar (lookAhead lineCommentEnd) <*> lineCommentEnd))-> where-> conc a Nothing = a-> conc a (Just b) = a ++ b-> lineCommentEnd =-> Just "\n" <$ char '\n'-> <|> Nothing <$ eof--Try is used in the block comment for the two symbol bits because we-want to backtrack if we read the first symbol but the second symbol-isn't there.--> blockComment :: Dialect -> Parser Token-> blockComment _ =-> (\s -> BlockComment $ concat ["/*",s]) <$>-> (try (string "/*") *> commentSuffix 0)-> where-> commentSuffix :: Int -> Parser String-> commentSuffix n = do-> -- read until a possible end comment or nested comment-> x <- takeWhile (\e -> e /= '/' && e /= '*')-> choice [-- close comment: if the nesting is 0, done-> -- otherwise recurse on commentSuffix-> try (string "*/") *> let t = concat [x,"*/"]-> in if n == 0-> then return t-> else (\s -> concat [t,s]) <$> commentSuffix (n - 1)-> -- nested comment, recurse-> ,try (string "/*") *> ((\s -> concat [x,"/*",s]) <$> commentSuffix (n + 1))-> -- not an end comment or nested comment, continue-> ,(\c s -> x ++ [c] ++ s) <$> anyChar <*> commentSuffix n]---This is to improve user experience: provide an error if we see */-outside a comment. This could potentially break postgres ops with */-in them (which is a stupid thing to do). In other cases, the user-should write * / instead (I can't think of any cases when this would-be valid syntax though).--> dontParseEndBlockComment :: Dialect -> Parser Token-> dontParseEndBlockComment _ =-> -- don't use try, then it should commit to the error-> try (string "*/") *> fail "comment end without comment start"---Some helper combinators--> startsWith :: (Char -> Bool) -> (Char -> Bool) -> Parser String-> startsWith p ps = do-> c <- satisfy p-> choice [(:) c <$> (takeWhile1 ps)-> ,return [c]]--> takeWhile1 :: (Char -> Bool) -> Parser String-> takeWhile1 p = many1 (satisfy p)--> takeWhile :: (Char -> Bool) -> Parser String-> takeWhile p = many (satisfy p)--> takeTill :: (Char -> Bool) -> Parser String-> takeTill p = manyTill anyChar (peekSatisfy p)--> peekSatisfy :: (Char -> Bool) -> Parser ()-> peekSatisfy p = void $ lookAhead (satisfy p)--This utility function will accurately report if the two tokens are-pretty printed, if they should lex back to the same two tokens. This-function is used in testing (and can be used in other places), and-must not be implemented by actually trying to print both tokens and-then lex them back from a single string (because then we would have-the risk of thinking two tokens cannot be together when there is bug-in the lexer, which the testing is supposed to find).--maybe do some quick checking to make sure this function only gives-true negatives: check pairs which return false actually fail to lex or-give different symbols in return: could use quickcheck for this--a good sanity test for this function is to change it to always return-true, then check that the automated tests return the same number of-successes. I don't think it succeeds this test at the moment--> -- | Utility function to tell you if a list of tokens-> -- will pretty print then lex back to the same set of tokens.-> -- Used internally, might be useful for generating SQL via lexical tokens.-> tokenListWillPrintAndLex :: Dialect -> [Token] -> Bool-> tokenListWillPrintAndLex _ [] = True-> tokenListWillPrintAndLex _ [_] = True-> tokenListWillPrintAndLex d (a:b:xs) =-> tokensWillPrintAndLex d a b && tokenListWillPrintAndLex d (b:xs)--> tokensWillPrintAndLex :: Dialect -> Token -> Token -> Bool-> tokensWillPrintAndLex d a b--a : followed by an identifier character will look like a host param-followed by = or : makes a different symbol--> | Symbol ":" <- a-> , checkFirstBChar (\x -> isIdentifierChar x || x `elem` ":=") = False--two symbols next to eachother will fail if the symbols can combine and-(possibly just the prefix) look like a different symbol--> | diPostgresSymbols d-> , Symbol a' <- a-> , Symbol b' <- b-> , b' `notElem` ["+", "-"] || or (map (`elem` a') "~!@#%^&|`?") = False--check two adjacent symbols in non postgres where the combination-possibilities are much more limited. This is ansi behaviour, it might-be different when the other dialects are done properly--> | Symbol a' <- a-> , Symbol b' <- b-> , (a',b') `elem` [("<",">")-> ,("<","=")-> ,(">","=")-> ,("!","=")-> ,("|","|")-> ,("||","|")-> ,("|","||")-> ,("||","||")-> ,("<",">=")-> ] = False--two whitespaces will be combined--> | Whitespace {} <- a-> , Whitespace {} <- b = False--line comment without a newline at the end will eat the next token--> | LineComment {} <- a-> , checkLastAChar (/='\n') = False--check the last character of the first token and the first character of-the second token forming a comment start or end symbol--> | let f '-' '-' = True-> f '/' '*' = True-> f '*' '/' = True-> f _ _ = False-> in checkBorderChars f = False--a symbol will absorb a following .-TODO: not 100% on this always being bad--> | Symbol {} <- a-> , checkFirstBChar (=='.') = False--cannot follow a symbol ending in : with another token starting with :--> | let f ':' ':' = True-> f _ _ = False-> in checkBorderChars f = False--unquoted identifier followed by an identifier letter--> | Identifier Nothing _ <- a-> , checkFirstBChar isIdentifierChar = False--a quoted identifier using ", followed by a " will fail--> | Identifier (Just (_,"\"")) _ <- a-> , checkFirstBChar (=='"') = False--prefixed variable followed by an identifier char will be absorbed--> | PrefixedVariable {} <- a-> , checkFirstBChar isIdentifierChar = False--a positional arg will absorb a following digit--> | PositionalArg {} <- a-> , checkFirstBChar isDigit = False--a string ending with ' followed by a token starting with ' will be absorbed--> | SqlString _ "'" _ <- a-> , checkFirstBChar (=='\'') = False--a number followed by a . will fail or be absorbed--> | SqlNumber {} <- a-> , checkFirstBChar (=='.') = False--a number followed by an e or E will fail or be absorbed--> | SqlNumber {} <- a-> , checkFirstBChar (\x -> x =='e' || x == 'E') = False--two numbers next to eachother will fail or be absorbed--> | SqlNumber {} <- a-> , SqlNumber {} <- b = False---> | otherwise = True--> where-> prettya = prettyToken d a-> prettyb = prettyToken d b-> -- helper function to run a predicate on the-> -- last character of the first token and the first-> -- character of the second token-> checkBorderChars f-> | (_:_) <- prettya-> , (fb:_) <- prettyb-> , la <- last prettya-> = f la fb-> checkBorderChars _ = False-> checkFirstBChar f = case prettyb of-> (b':_) -> f b'-> _ -> False-> checkLastAChar f = case prettya of-> (_:_) -> f $ last prettya-> _ -> False-----TODO:--make the tokenswill print more dialect accurate. Maybe add symbol- chars and identifier chars to the dialect definition and use them from- here--start adding negative / different parse dialect tests--add token tables and tests for oracle, sql server-review existing tables--look for refactoring opportunities, especially the token-generation tables in the tests--do some user documentation on lexing, and lexing/dialects--start thinking about a more separated design for the dialect handling--lexing tests are starting to take a really long time, so split the-tests so it is much easier to run all the tests except the lexing-tests which only need to be run when working on the lexer (which-should be relatively uncommon), or doing a commit or finishing off a-series of commits,--start writing the error message tests:- generate/write a large number of syntax errors- create a table with the source and the error message- try to compare some different versions of code to compare the- quality of the error messages by hand-- get this checked in so improvements and regressions in the error- message quality can be tracked a little more easily (although it will- still be manual)--try again to add annotation to the ast
+ Language/SQL/SimpleSQL/Parse.hs view
@@ -0,0 +1,2370 @@++{-+= TOC:++notes+Public api+Names - parsing identifiers+Typenames+Scalar expressions+ simple literals+ star, param+ parens expression, row constructor and scalar subquery+ case, cast, exists, unique, array/ multiset constructor+ typed literal, app, special function, aggregate, window function+ suffixes: in, between, quantified comparison, match predicate, array+ subscript, escape, collate+ operators+ scalar expression top level+ helpers+query expressions+ select lists+ from clause+ other table expression clauses:+ where, group by, having, order by, offset and fetch+ common table expressions+ query expression+ set operations+lexers+utilities++= Notes about the code++The lexers appear at the bottom of the file. There tries to be a clear+separation between the lexers and the other parser which only use the+lexers, this isn't 100% complete at the moment and needs fixing.++== Left factoring++The parsing code is aggressively left factored, and try is avoided as+much as possible. Try is avoided because:++ * when it is overused it makes the code hard to follow+ * when it is overused it makes the parsing code harder to debug+ * it makes the parser error messages much worse++The code could be made a bit simpler with a few extra 'trys', but this+isn't done because of the impact on the parser error+messages. Apparently it can also help the speed but this hasn't been+looked into.++== Parser error messages++A lot of care has been given to generating good parser error messages+for invalid syntax. There are a few utils below which partially help+in this area.++There is a set of crafted bad expressions in ErrorMessages.hs, these+are used to guage the quality of the error messages and monitor+regressions by hand. The use of <?> is limited as much as possible:+each instance should justify itself by improving an actual error+message.++There is also a plan to write a really simple expression parser which+doesn't do precedence and associativity, and the fix these with a pass+over the ast. I don't think there is any other way to sanely handle+the common prefixes between many infix and postfix multiple keyword+operators, and some other ambiguities also. This should help a lot in+generating good error messages also.++Both the left factoring and error message work are greatly complicated+by the large number of shared prefixes of the various elements in SQL+syntax.++== Main left factoring issues++There are three big areas which are tricky to left factor:++ * typenames+ * scalar expressions which can start with an identifier+ * infix and suffix operators++=== typenames++There are a number of variations of typename syntax. The standard+deals with this by switching on the name of the type which is parsed+first. This code doesn't do this currently, but might in the+future. Taking the approach in the standard grammar will limit the+extensibility of the parser and might affect the ease of adapting to+support other sql dialects.++=== identifier scalar expressions++There are a lot of scalar expression nodes which start with+identifiers, and can't be distinguished the tokens after the initial+identifier are parsed. Using try to implement these variations is very+simple but makes the code much harder to debug and makes the parser+error messages really bad.++Here is a list of these nodes:++ * identifiers+ * function application+ * aggregate application+ * window application+ * typed literal: typename 'literal string'+ * interval literal which is like the typed literal with some extras++There is further ambiguity e.g. with typed literals with precision,+functions, aggregates, etc. - these are an identifier, followed by+parens comma separated scalar expressions or something similar, and it+is only later that we can find a token which tells us which flavour it+is.++There is also a set of nodes which start with an identifier/keyword+but can commit since no other syntax can start the same way:++ * case+ * cast+ * exists, unique subquery+ * array constructor+ * multiset constructor+ * all the special syntax functions: extract, position, substring,+ convert, translate, overlay, trim, etc.++The interval literal mentioned above is treated in this group at the+moment: if we see 'interval' we parse it either as a full interval+literal or a typed literal only.++Some items in this list might have to be fixed in the future, e.g. to+support standard 'substring(a from 3 for 5)' as well as regular+function substring syntax 'substring(a,3,5) at the same time.++The work in left factoring all this is mostly done, but there is still+a substantial bit to complete and this is by far the most difficult+bit. At the moment, the work around is to use try, the downsides of+which is the poor parsing error messages.++=== infix and suffix operators++== permissiveness++The parser is very permissive in many ways. This departs from the+standard which is able to eliminate a number of possibilities just in+the grammar, which this parser allows. This is done for a number of+reasons:++ * it makes the parser simple - less variations+ * it should allow for dialects and extensibility more easily in the+ future (e.g. new infix binary operators with custom precedence)+ * many things which are effectively checked in the grammar in the+ standard, can be checked using a typechecker or other simple static+ analysis++To use this code as a front end for a sql engine, or as a sql validity+checker, you will need to do a lot of checks on the ast. A+typechecker/static checker plus annotation to support being a compiler+front end is planned but not likely to happen too soon.++Some of the areas this affects:++typenames: the variation of the type name should switch on the actual+name given according to the standard, but this code only does this for+the special case of interval type names. E.g. you can write 'int+collate C' or 'int(15,2)' and this will parse as a character type name+or a precision scale type name instead of being rejected.++scalar expressions: every variation on scalar expressions uses the same+parser/syntax. This means we don't try to stop non boolean valued+expressions in boolean valued contexts in the parser. Another area+this affects is that we allow general scalar expressions in group by,+whereas the standard only allows column names with optional collation.++These are all areas which are specified (roughly speaking) in the+syntax rather than the semantics in the standard, and we are not+fixing them in the syntax but leaving them till the semantic checking+(which doesn't exist in this code at this time).+-}++{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This is the module with the parser functions.+module Language.SQL.SimpleSQL.Parse+ (parseQueryExpr+ ,parseScalarExpr+ ,parseStatement+ ,parseStatements+ ,ParseError(..)+ ,prettyError+ ,ansi2011+ ) where++import Text.Megaparsec+ (ParsecT+ ,runParserT++ ,ParseErrorBundle(..)+ ,errorBundlePretty++ ,(<?>)+ ,(<|>)+ ,token+ ,choice+ ,eof+ ,try+ ,sepBy+ ,sepBy1+ ,optional+ ,option+ ,some+ ,many+ ,between+ )+import qualified Control.Monad.Combinators.Expr as E+import qualified Control.Monad.Permutations as P++import Control.Monad.Reader+ (Reader+ ,runReader+ ,ask+ ,asks+ )++import qualified Data.Set as Set+import Data.Void (Void)++import Control.Monad (guard, void)+import Control.Applicative ((<**>))+import Data.Char (isDigit)+import Data.List (sort,groupBy)+import Data.Function (on)+import Data.Maybe (catMaybes, isJust, mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T++import Language.SQL.SimpleSQL.Syntax +import Language.SQL.SimpleSQL.Dialect+import qualified Language.SQL.SimpleSQL.Lex as L++------------------------------------------------------------------------------++-- = Public API++-- | Parses a query expr, trailing semicolon optional.+parseQueryExpr+ :: Dialect+ -- ^ dialect of SQL to use+ -> Text+ -- ^ filename to use in error messages+ -> Maybe (Int,Int)+ -- ^ line number and column number of the first character+ -- in the source to use in error messages+ -> Text+ -- ^ the SQL source to parse+ -> Either ParseError QueryExpr+parseQueryExpr = wrapParse topLevelQueryExpr++-- | Parses a statement, trailing semicolon optional.+parseStatement+ :: Dialect+ -- ^ dialect of SQL to use+ -> Text+ -- ^ filename to use in error messages+ -> Maybe (Int,Int)+ -- ^ line number and column number of the first character+ -- in the source to use in error messages+ -> Text+ -- ^ the SQL source to parse+ -> Either ParseError Statement+parseStatement = wrapParse topLevelStatement++-- | Parses a list of statements, with semi colons between+-- them. The final semicolon is optional.+parseStatements+ :: Dialect+ -- ^ dialect of SQL to use+ -> Text+ -- ^ filename to use in error messages+ -> Maybe (Int,Int)+ -- ^ line number and column number of the first character+ -- in the source to use in error messages+ -> Text+ -- ^ the SQL source to parse+ -> Either ParseError [Statement]+parseStatements = wrapParse statements++-- | Parses a scalar expression.+parseScalarExpr+ :: Dialect+ -- ^ dialect of SQL to use+ -> Text+ -- ^ filename to use in error messages+ -> Maybe (Int,Int)+ -- ^ line number and column number of the first character+ -- in the source to use in error messages+ -> Text+ -- ^ the SQL source to parse+ -> Either ParseError ScalarExpr+parseScalarExpr = wrapParse scalarExpr++-- Megaparsec is too clever, so have to create a new type to represent+-- either a lex error or a parse error++data ParseError+ = LexError L.ParseError+ | ParseError (ParseErrorBundle L.SQLStream Void)++prettyError :: ParseError -> Text+prettyError (LexError e) = T.pack $ errorBundlePretty e+prettyError (ParseError e) = T.pack $ errorBundlePretty e++{-+This helper function takes the parser given and:++sets the position when parsing+automatically skips leading whitespace+checks the parser parses all the input using eof+converts the error return to the nice wrapper+-}++wrapParse :: Parser a+ -> Dialect+ -> Text+ -> Maybe (Int,Int)+ -> Text+ -> Either ParseError a+wrapParse parser d f p src = do+ lx <- either (Left . LexError) Right $ L.lexSQLWithPositions d f p src+ either (Left . ParseError) Right $ + runReader (runParserT (parser <* (eof <?> "")) (T.unpack f)+ $ L.SQLStream (T.unpack src) $ filter notSpace lx) d+ where+ notSpace = notSpace' . L.tokenVal+ notSpace' (L.Whitespace {}) = False+ notSpace' (L.LineComment {}) = False+ notSpace' (L.BlockComment {}) = False+ notSpace' _ = True++------------------------------------------------------------------------------++-- parsing code++type Parser = ParsecT Void L.SQLStream (Reader Dialect)++{-+------------------------------------------------++= Names++Names represent identifiers and a few other things. The parser here+handles regular identifiers, dotten chain identifiers, quoted+identifiers and unicode quoted identifiers.++Dots: dots in identifier chains are parsed here and represented in the+Iden constructor usually. If parts of the chains are non identifier+scalar expressions, then this is represented by a BinOp "."+instead. Dotten chain identifiers which appear in other contexts (such+as function names, table names, are represented as [Name] only.++Identifier grammar:++unquoted:+underscore <|> letter : many (underscore <|> alphanum++example+_example123++quoted:++double quote, many (non quote character or two double quotes+together), double quote++"example quoted"+"example with "" quote"++unicode quoted is the same as quoted in this parser, except it starts+with U& or u&++u&"example quoted"+-}++name :: Parser Name+name = do+ bl <- askDialect diKeywords+ uncurry Name <$> identifierTok bl++-- todo: replace (:[]) with a named function all over++names :: Parser [Name]+names = reverse <$> (((:[]) <$> name) <??*> anotherName)+ -- can't use a simple chain here since we+ -- want to wrap the . + name in a try+ -- this will change when this is left factored+ where+ anotherName :: Parser ([Name] -> [Name])+ anotherName = try ((:) <$> ((symbol "." *> name) <?> ""))++{-+= Type Names++Typenames are used in casts, and also in the typed literal syntax,+which is a typename followed by a string literal.++Here are the grammar notes:++== simple type name++just an identifier chain or a multi word identifier (this is a fixed+list of possibilities, e.g. as 'character varying', see below in the+parser code for the exact list).++<simple-type-name> ::= <identifier-chain>+ | multiword-type-identifier++== Precision type name++<precision-type-name> ::= <simple-type-name> <left paren> <unsigned-int> <right paren>++e.g. char(5)++note: above and below every where a simple type name can appear, this+means a single identifier/quoted or a dotted chain, or a multi word+identifier++== Precision scale type name++<precision-type-name> ::= <simple-type-name> <left paren> <unsigned-int> <comma> <unsigned-int> <right paren>++e.g. decimal(15,2)++== Lob type name++this is a variation on the precision type name with some extra info on+the units:++<lob-type-name> ::=+ <simple-type-name> <left paren> <unsigned integer> [ <multiplier> ] [ <char length units> ] <right paren>++<multiplier> ::= K | M | G+<char length units> ::= CHARACTERS | CODE_UNITS | OCTETS++(if both multiplier and char length units are missing, then this will+parse as a precision type name)++e.g.+clob(5M octets)++== char type name++this is a simple type with optional precision which allows the+character set or the collation to appear as a suffix:++<char type name> ::=+ <simple type name>+ [ <left paren> <unsigned-int> <right paren> ]+ [ CHARACTER SET <identifier chain> ]+ [ COLLATE <identifier chain> ]++e.g.++char(5) character set my_charset collate my_collation++= Time typename++this is typename with optional precision and either 'with time zone'+or 'without time zone' suffix, e.g.:++<datetime type> ::=+ [ <left paren> <unsigned-int> <right paren> ]+ <with or without time zone>+<with or without time zone> ::= WITH TIME ZONE | WITHOUT TIME ZONE+ WITH TIME ZONE | WITHOUT TIME ZONE++= row type name++<row type> ::=+ ROW <left paren> <field definition> [ { <comma> <field definition> }... ] <right paren>++<field definition> ::= <identifier> <type name>++e.g.+row(a int, b char(5))++= interval type name++<interval type> ::= INTERVAL <interval datetime field> [TO <interval datetime field>]++<interval datetime field> ::=+ <datetime field> [ <left paren> <unsigned int> [ <comma> <unsigned int> ] <right paren> ]++= array type name++<array type> ::= <data type> ARRAY [ <left bracket> <unsigned integer> <right bracket> ]++= multiset type name++<multiset type> ::= <data type> MULTISET++A type name will parse into the 'smallest' constructor it will fit in+syntactically, e.g. a clob(5) will parse to a precision type name, not+a lob type name.++Unfortunately, to improve the error messages, there is a lot of (left)+factoring in this function, and it is a little dense.+-}++typeName :: Parser TypeName+typeName =+ (rowTypeName <|> intervalTypeName <|> otherTypeName)+ <??*> tnSuffix+ where+ rowTypeName =+ RowTypeName <$> (keyword_ "row" *> parens (commaSep1 rowField))+ rowField = (,) <$> name <*> typeName+ ----------------------------+ intervalTypeName =+ keyword_ "interval" *>+ (uncurry IntervalTypeName <$> intervalQualifier)+ ----------------------------+ otherTypeName =+ nameOfType <**>+ (typeNameWithParens+ <|> pure Nothing <**> (timeTypeName <|> charTypeName)+ <|> pure TypeName)+ nameOfType = reservedTypeNames <|> names+ charTypeName = charSet <**> (option [] tcollate <$$$$> CharTypeName)+ <|> pure [] <**> (tcollate <$$$$> CharTypeName)+ typeNameWithParens =+ (openParen *> unsignedInteger)+ <**> (closeParen *> precMaybeSuffix+ <|> (precScaleTypeName <|> precLengthTypeName) <* closeParen)+ precMaybeSuffix = (. Just) <$> (timeTypeName <|> charTypeName)+ <|> pure (flip PrecTypeName)+ precScaleTypeName = (comma *> unsignedInteger) <$$$> PrecScaleTypeName+ precLengthTypeName =+ Just <$> lobPrecSuffix+ <**> (optional lobUnits <$$$$> PrecLengthTypeName)+ <|> pure Nothing <**> ((Just <$> lobUnits) <$$$$> PrecLengthTypeName)+ timeTypeName = tz <$$$> TimeTypeName+ ----------------------------+ lobPrecSuffix = PrecK <$ keyword_ "k"+ <|> PrecM <$ keyword_ "m"+ <|> PrecG <$ keyword_ "g"+ <|> PrecT <$ keyword_ "t"+ <|> PrecP <$ keyword_ "p"+ lobUnits = PrecCharacters <$ keyword_ "characters"+ -- char and byte are the oracle spelling+ -- todo: move these to oracle dialect+ <|> PrecCharacters <$ keyword_ "char"+ <|> PrecOctets <$ keyword_ "octets"+ <|> PrecOctets <$ keyword_ "byte"+ tz = True <$ keywords_ ["with", "time","zone"]+ <|> False <$ keywords_ ["without", "time","zone"]+ charSet = keywords_ ["character", "set"] *> names+ tcollate = keyword_ "collate" *> names+ ----------------------------+ tnSuffix = multiset <|> array+ multiset = MultisetTypeName <$ keyword_ "multiset"+ array = keyword_ "array" *>+ (optional (brackets unsignedInteger) <$$> ArrayTypeName)+ ----------------------------+ -- this parser handles the fixed set of multi word+ -- type names, plus all the type names which are+ -- reserved words+ reservedTypeNames = do+ stn <- askDialect diSpecialTypeNames+ (:[]) . Name Nothing . T.unwords <$> makeKeywordTree stn+ ++{-+= Scalar expressions++== simple literals++See the stringToken lexer below for notes on string literal syntax.+-}++stringLit :: Parser ScalarExpr+stringLit = (\(s,e,t) -> StringLit s e t) <$> stringTokExtend++numberLit :: Parser ScalarExpr+numberLit = NumLit <$> sqlNumberTok False++simpleLiteral :: Parser ScalarExpr+simpleLiteral = numberLit <|> stringLit++{-+== star, param, host param++=== star++used in select *, select x.*, and agg(*) variations, and some other+places as well. The parser doesn't attempt to check that the star is+in a valid context, it parses it OK in any scalar expression context.+-}++star :: Parser ScalarExpr+star = Star <$ symbol "*"++{-+== parameter++unnamed parameter or named parameter+use in e.g. select * from t where a = ?+select x from t where x > :param+-}++parameter :: Parser ScalarExpr+parameter = choice+ [Parameter <$ questionMark+ ,HostParameter+ <$> hostParamTok+ <*> optional (keyword "indicator" *> hostParamTok)]++-- == positional arg++positionalArg :: Parser ScalarExpr+positionalArg = PositionalArg <$> positionalArgTok++{-+== parens++scalar expression parens, row ctor and scalar subquery+-}++parensExpr :: Parser ScalarExpr+parensExpr = parens $ choice+ [SubQueryExpr SqSq <$> queryExpr+ ,ctor <$> commaSep1 scalarExpr]+ where+ ctor [a] = Parens a+ ctor as = SpecialOp [Name Nothing "rowctor"] as++{-+== case, cast, exists, unique, array/multiset constructor, interval++All of these start with a fixed keyword which is reserved, so no other+syntax can start with the same keyword.++=== case expression+-}++caseExpr :: Parser ScalarExpr+caseExpr =+ Case <$> (keyword_ "case" *> optional scalarExpr)+ <*> some whenClause+ <*> optional elseClause+ <* keyword_ "end"+ where+ whenClause = (,) <$> (keyword_ "when" *> commaSep1 scalarExpr)+ <*> (keyword_ "then" *> scalarExpr)+ elseClause = keyword_ "else" *> scalarExpr++{-+=== cast++cast: cast(expr as type)+-}++cast :: Parser ScalarExpr+cast = keyword_ "cast" *>+ parens (Cast <$> scalarExpr+ <*> (keyword_ "as" *> typeName))++{-+=== convert++convertSqlServer: SqlServer dialect CONVERT(data_type(length), expression, style)+-}++convertSqlServer :: Parser ScalarExpr+convertSqlServer = guardDialect diConvertFunction+ *> keyword_ "convert" *>+ parens (Convert <$> typeName <*> (comma *> scalarExpr)+ <*> optional (comma *> unsignedInteger))++{-+=== exists, unique++subquery expression:+[exists|unique] (queryexpr)+-}++subquery :: Parser ScalarExpr+subquery = SubQueryExpr <$> sqkw <*> parens queryExpr+ where+ sqkw = SqExists <$ keyword_ "exists" <|> SqUnique <$ keyword_ "unique"++-- === array/multiset constructor++arrayCtor :: Parser ScalarExpr+arrayCtor = keyword_ "array" >>+ choice+ [ArrayCtor <$> parens queryExpr+ ,Array (Iden [Name Nothing "array"]) <$> brackets (commaSep scalarExpr)]++{-+As far as I can tell, table(query expr) is just syntax sugar for+multiset(query expr). It must be there for compatibility or something.+-}++multisetCtor :: Parser ScalarExpr+multisetCtor =+ choice+ [keyword_ "multiset" >>+ choice+ [MultisetQueryCtor <$> parens queryExpr+ ,MultisetCtor <$> brackets (commaSep scalarExpr)]+ ,keyword_ "table" >>+ MultisetQueryCtor <$> parens queryExpr]++nextValueFor :: Parser ScalarExpr+nextValueFor = keywords_ ["next","value","for"] >>+ NextValueFor <$> names++{-+=== interval++interval literals are a special case and we follow the grammar less+permissively here++parse SQL interval literals, something like+interval '5' day (3)+or+interval '5' month++if the literal looks like this:+interval 'something'++then it is parsed as a regular typed literal. It must have a+interval-datetime-field suffix to parse as an intervallit++It uses try because of a conflict with interval type names: todo, fix+this. also fix the monad -> applicative+-}++intervalLit :: Parser ScalarExpr+intervalLit = try (keyword_ "interval" >> do+ s <- optional $ choice [Plus <$ symbol_ "+"+ ,Minus <$ symbol_ "-"]+ lit <- singleQuotesOnlyStringTok+ q <- optional intervalQualifier+ mkIt s lit q)+ where+ mkIt Nothing val Nothing = pure $ TypedLit (TypeName [Name Nothing "interval"]) val+ mkIt s val (Just (a,b)) = pure $ IntervalLit s val a b+ mkIt (Just {}) _val Nothing = fail "cannot use sign without interval qualifier"++{-+== typed literal, app, special, aggregate, window, iden++All of these start with identifiers (some of the special functions+start with reserved keywords).++they are all variations on suffixes on the basic identifier parser++The windows is a suffix on the app parser++=== iden prefix term++all the scalar expressions which start with an identifier++(todo: really put all of them here instead of just some of them)+-}++idenExpr :: Parser ScalarExpr+idenExpr =+ -- todo: work out how to left factor this+ try (TypedLit <$> typeName <*> singleQuotesOnlyStringTok)+ <|> (names <**> option Iden app)+ <|> keywordFunctionOrIden+ where+ -- special cases for keywords that can be parsed as an iden or app+ keywordFunctionOrIden = try $ do+ x <- unquotedIdentifierTok [] Nothing+ d <- askDialect id+ let i = T.toLower x `elem` diIdentifierKeywords d+ a = T.toLower x `elem` diAppKeywords d+ case () of+ _ | i && a -> pure [Name Nothing x] <**> option Iden app+ | i -> pure (Iden [Name Nothing x])+ | a -> pure [Name Nothing x] <**> app+ | otherwise -> fail ""+++{-+=== special++These are keyword operators which don't look like normal prefix,+postfix or infix binary operators. They mostly look like function+application but with keywords in the argument list instead of commas+to separate the arguments.++the special op keywords+parse an operator which is+operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)+-}++data SpecialOpKFirstArg = SOKNone+ | SOKOptional+ | SOKMandatory++specialOpK :: Text -- name of the operator+ -> SpecialOpKFirstArg -- has a first arg without a keyword+ -> [(Text,Bool)] -- the other args with their keywords+ -- and whether they are optional+ -> Parser ScalarExpr+specialOpK opName firstArg kws =+ keyword_ opName >> do+ void openParen+ let pfa = do+ e <- scalarExpr+ -- check we haven't parsed the first+ -- keyword as an identifier+ case (e,kws) of+ (Iden [Name Nothing i], (k,_):_)+ | T.toLower i == k ->+ fail $ "cannot use keyword here: " ++ T.unpack i+ _ -> pure ()+ pure e+ fa <- case firstArg of+ SOKNone -> pure Nothing+ SOKOptional -> optional (try pfa)+ SOKMandatory -> Just <$> pfa+ as <- mapM parseArg kws+ void closeParen+ pure $ SpecialOpK [Name Nothing opName] fa $ catMaybes as+ where+ parseArg (nm,mand) =+ let p = keyword_ nm >> scalarExpr+ in fmap (nm,) <$> if mand+ then Just <$> p+ else optional (try p)++{-+The actual operators:++EXTRACT( date_part FROM expression )++POSITION( string1 IN string2 )++SUBSTRING(extraction_string FROM starting_position [FOR length]+[COLLATE collation_name])++CONVERT(char_value USING conversion_char_name)++TRANSLATE(char_value USING translation_name)++OVERLAY(string PLACING embedded_string FROM start+[FOR length])++TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]+target_string+[COLLATE collation_name] )+-}++specialOpKs :: Parser ScalarExpr+specialOpKs = choice $ map try+ [extract, position, substring, convert, translate, overlay, trim]++extract :: Parser ScalarExpr+extract = specialOpK "extract" SOKMandatory [("from", True)]++position :: Parser ScalarExpr+position = specialOpK "position" SOKMandatory [("in", True)]++{-+strictly speaking, the substring must have at least one of from and+for, but the parser doens't enforce this+-}++substring :: Parser ScalarExpr+substring = specialOpK "substring" SOKMandatory+ [("from", False),("for", False)]++convert :: Parser ScalarExpr+convert = specialOpK "convert" SOKMandatory [("using", True)]+++translate :: Parser ScalarExpr+translate = specialOpK "translate" SOKMandatory [("using", True)]++overlay :: Parser ScalarExpr+overlay = specialOpK "overlay" SOKMandatory+ [("placing", True),("from", True),("for", False)]++{-+trim is too different because of the optional char, so a custom parser+the both ' ' is filled in as the default if either parts are missing+in the source+-}++trim :: Parser ScalarExpr+trim =+ keyword "trim" >>+ parens (mkTrim+ <$> option "both" sides+ <*> option " " singleQuotesOnlyStringTok+ <*> (keyword_ "from" *> scalarExpr))+ where+ sides = choice ["leading" <$ keyword_ "leading"+ ,"trailing" <$ keyword_ "trailing"+ ,"both" <$ keyword_ "both"]+ mkTrim fa ch fr =+ SpecialOpK [Name Nothing "trim"] Nothing+ $ catMaybes [Just (fa,StringLit "'" "'" ch)+ ,Just ("from", fr)]++{-+=== app, aggregate, window++This parses all these variations:+normal function application with just a csv of scalar exprs+aggregate variations (distinct, order by in parens, filter and where+ suffixes)+window apps (fn/agg followed by over)++This code is also a little dense like the typename code because of+left factoring, later they will even have to be partially combined+together.+-}++app :: Parser ([Name] -> ScalarExpr)+app =+ openParen *> choice+ [duplicates+ <**> (commaSep1 scalarExpr+ <**> ((option [] orderBy <* closeParen)+ <**> (optional afilter <$$$$$> AggregateApp)))+ -- separate cases with no all or distinct which must have at+ -- least one scalar expr+ ,commaSep1 scalarExpr+ <**> choice+ [closeParen *> choice+ [window+ ,withinGroup+ ,(Just <$> afilter) <$$$> aggAppWithoutDupeOrd+ ,pure (flip App)]+ ,orderBy <* closeParen+ <**> (optional afilter <$$$$> aggAppWithoutDupe)]+ -- no scalarExprs: duplicates and order by not allowed+ ,([] <$ closeParen) <**> option (flip App) (window <|> withinGroup)+ ]+ where+ aggAppWithoutDupeOrd n es f = AggregateApp n SQDefault es [] f+ aggAppWithoutDupe n = AggregateApp n SQDefault++afilter :: Parser ScalarExpr+afilter = keyword_ "filter" *> parens (keyword_ "where" *> scalarExpr)++withinGroup :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)+withinGroup =+ (keywords_ ["within", "group"] *> parens orderBy) <$$$> AggregateAppGroup++{-+==== window++parse a window call as a suffix of a regular function call+this looks like this:+functionname(args) over ([partition by ids] [order by orderitems])++No support for explicit frames yet.++TODO: add window support for other aggregate variations, needs some+changes to the syntax also+-}++window :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)+window =+ keyword_ "over" *> openParen *> option [] partitionBy+ <**> (option [] orderBy+ <**> ((optional frameClause <* closeParen) <$$$$$> WindowApp))+ where+ partitionBy = keywords_ ["partition","by"] *> commaSep1 scalarExpr+ frameClause =+ frameRowsRange -- TODO: this 'and' could be an issue+ <**> choice [(keyword_ "between" *> frameLimit True)+ <**> ((keyword_ "and" *> frameLimit True)+ <$$$> FrameBetween)+ -- maybe this should still use a b expression+ -- for consistency+ ,frameLimit False <**> pure (flip FrameFrom)]+ frameRowsRange = FrameRows <$ keyword_ "rows"+ <|> FrameRange <$ keyword_ "range"+ frameLimit useB =+ choice+ [Current <$ keywords_ ["current", "row"]+ -- todo: create an automatic left factor for stuff like this+ ,keyword_ "unbounded" *>+ choice [UnboundedPreceding <$ keyword_ "preceding"+ ,UnboundedFollowing <$ keyword_ "following"]+ ,(if useB then scalarExprB else scalarExpr)+ <**> (Preceding <$ keyword_ "preceding"+ <|> Following <$ keyword_ "following")+ ]++{-+== suffixes++These are all generic suffixes on any scalar expr++=== in++in: two variations:+a in (expr0, expr1, ...)+a in (queryexpr)+-}++inSuffix :: Parser (ScalarExpr -> ScalarExpr)+inSuffix =+ mkIn <$> inty+ <*> parens (choice+ [InQueryExpr <$> queryExpr+ ,InList <$> commaSep1 scalarExpr])+ where+ inty = choice [True <$ keyword_ "in"+ ,False <$ keywords_ ["not","in"]]+ mkIn i v e = In i e v++{-+=== between++between:+expr between expr and expr++There is a complication when parsing between - when parsing the second+expression it is ambiguous when you hit an 'and' whether it is a+binary operator or part of the between. This code follows what+postgres does, which might be standard across SQL implementations,+which is that you can't have a binary and operator in the middle+expression in a between unless it is wrapped in parens. The 'bExpr+parsing' is used to create alternative scalar expression parser which+is identical to the normal one expect it doesn't recognise the binary+and operator. This is the call to scalarExprB.+-}++betweenSuffix :: Parser (ScalarExpr -> ScalarExpr)+betweenSuffix =+ makeOp . Name Nothing+ <$> opName+ <*> scalarExprB+ <*> (keyword_ "and" *> scalarExprB)+ where+ opName = choice+ ["between" <$ keyword_ "between"+ ,"not between" <$ try (keywords_ ["not","between"])]+ makeOp n b c a = SpecialOp [n] [a,b,c]++{-+=== quantified comparison++a = any (select * from t)+-}++quantifiedComparisonSuffix :: Parser (ScalarExpr -> ScalarExpr)+quantifiedComparisonSuffix = do+ c <- comp+ cq <- compQuan+ q <- parens queryExpr+ pure $ \v -> QuantifiedComparison v [c] cq q+ where+ comp = Name Nothing <$> choice (map symbol+ ["=", "<>", "<=", "<", ">", ">="])+ compQuan = choice+ [CPAny <$ keyword_ "any"+ ,CPSome <$ keyword_ "some"+ ,CPAll <$ keyword_ "all"]++{-+=== match++a match (select a from t)+-}++matchPredicateSuffix :: Parser (ScalarExpr -> ScalarExpr)+matchPredicateSuffix = do+ keyword_ "match"+ u <- option False (True <$ keyword_ "unique")+ q <- parens queryExpr+ pure $ \v -> Match v u q++-- === array subscript++arraySuffix :: Parser (ScalarExpr -> ScalarExpr)+arraySuffix = do+ es <- brackets (commaSep scalarExpr)+ pure $ \v -> Array v es++{-+=== escape++It is going to be really difficult to support an arbitrary character+for the escape now there is a separate lexer ...++TODO: this needs fixing. Escape is only part of other nodes, and not a+separate suffix.+-}++{-escapeSuffix :: Parser (ScalarExpr -> ScalarExpr)+escapeSuffix = do+ ctor <- choice+ [Escape <$ keyword_ "escape"+ ,UEscape <$ keyword_ "uescape"]+ c <- escapeChar+ pure $ \v -> ctor v c+ where+ escapeChar :: Parser Char+ escapeChar = (identifierTok [] Nothing <|> symbolTok Nothing) >>= oneOnly+ oneOnly :: String -> Parser Char+ oneOnly c = case c of+ [c'] -> pure c'+ _ -> fail "escape char must be single char"+-}++-- === collate++collateSuffix:: Parser (ScalarExpr -> ScalarExpr)+collateSuffix = do+ keyword_ "collate"+ i <- names+ pure $ \v -> Collate v i++{-+== odbc syntax++the parser supports three kinds of odbc syntax, two of which are+scalar expressions (the other is a variation on joins)+-}+++odbcExpr :: Parser ScalarExpr+odbcExpr = between (symbol "{") (symbol "}")+ (odbcTimeLit <|> odbcFunc)+ where+ odbcTimeLit =+ OdbcLiteral <$> choice [OLDate <$ keyword "d"+ ,OLTime <$ keyword "t"+ ,OLTimestamp <$ keyword "ts"]+ <*> singleQuotesOnlyStringTok+ -- todo: this parser is too general, the expr part+ -- should be only a function call (from a whitelist of functions)+ -- or the extract operator+ odbcFunc = OdbcFunc <$> (keyword "fn" *> scalarExpr)++{-+== operators++The 'regular' operators in this parsing and in the abstract syntax are+unary prefix, unary postfix and binary infix operators. The operators+can be symbols (a + b), single keywords (a and b) or multiple keywords+(a is similar to b).++TODO: carefully review the precedences and associativities.++TODO: to fix the parsing completely, I think will need to parse+without precedence and associativity and fix up afterwards, since SQL+syntax is way too messy. It might be possible to avoid this if we+wanted to avoid extensibility and to not be concerned with parse error+messages, but both of these are too important.+-}++opTable :: Bool -> [[E.Operator Parser ScalarExpr]]+opTable bExpr =+ [-- parse match and quantified comparisons as postfix ops+ -- todo: left factor the quantified comparison with regular+ -- binary comparison, somehow+ [postfix $ try quantifiedComparisonSuffix+ ,postfix matchPredicateSuffix]++ ,[binarySymL "."]++ ,[postfix arraySuffix+ ,postfix collateSuffix]++ ,[prefixSym "+", prefixSym "-"]++ ,[binarySymL "^"]++ ,[binarySymL "*"+ ,binarySymL "/"+ ,binarySymL "%"]++ ,[binarySymL "+"+ ,binarySymL "-"]++ ,[binarySymR "||"+ ,prefixSym "~"+ ,binarySymR "&"+ ,binarySymR "|"]++ ,[binaryKeywordN "overlaps"]++ ,[binaryKeywordN "like"+ -- have to use try with inSuffix because of a conflict+ -- with 'in' in position function, and not between+ -- between also has a try in it to deal with 'not'+ -- ambiguity+ ,postfix $ try inSuffix+ ,postfix betweenSuffix]+ -- todo: figure out where to put the try?+ ++ [binaryKeywordsN $ makeKeywordTree+ ["not like"+ ,"is similar to"+ ,"is not similar to"]]+ ++ [multisetBinOp]++ ,[binarySymN "<"+ ,binarySymN ">"+ ,binarySymN ">="+ ,binarySymN "<="+ ,binarySymR "!="+ ,binarySymR "<>"+ ,binarySymR "="]++ ,[postfixKeywords $ makeKeywordTree+ ["is null"+ ,"is not null"+ ,"is true"+ ,"is not true"+ ,"is false"+ ,"is not false"+ ,"is unknown"+ ,"is not unknown"]]+ ++ [binaryKeywordsN $ makeKeywordTree+ ["is distinct from"+ ,"is not distinct from"]]++ ,[prefixKeyword "not"]++ ,[binaryKeywordL "and" | not bExpr]++ ,[binaryKeywordL "or"]++ ]+ where+ binarySymL nm = E.InfixL (mkBinOp nm <$ symbol_ nm)+ binarySymR nm = E.InfixR (mkBinOp nm <$ symbol_ nm)+ binarySymN nm = E.InfixN (mkBinOp nm <$ symbol_ nm)+ binaryKeywordN nm = E.InfixN (mkBinOp nm <$ keyword_ nm)+ binaryKeywordL nm = E.InfixL (mkBinOp nm <$ keyword_ nm)+ mkBinOp nm a b = BinOp a (mkNm nm) b+ prefixSym nm = prefix (PrefixOp (mkNm nm) <$ symbol_ nm)+ prefixKeyword nm = prefix (PrefixOp (mkNm nm) <$ keyword_ nm)+ mkNm nm = [Name Nothing nm]+ binaryKeywordsN p =+ E.InfixN (do+ o <- try p+ pure (\a b -> BinOp a [Name Nothing $ T.unwords o] b))+ multisetBinOp = E.InfixL (do+ keyword_ "multiset"+ o <- choice [Union <$ keyword_ "union"+ ,Intersect <$ keyword_ "intersect"+ ,Except <$ keyword_ "except"]+ d <- option SQDefault duplicates+ pure (\a b -> MultisetBinOp a o d b))+ postfixKeywords p =+ postfix $ do+ o <- try p+ pure $ PostfixOp [Name Nothing $ T.unwords o]+ -- parse repeated prefix or postfix operators+ postfix p = E.Postfix $ foldr1 (flip (.)) <$> some p+ prefix p = E.Prefix $ foldr1 (.) <$> some p++{-+== scalar expression top level++This parses most of the scalar exprs.The order of the parsers and use+of try is carefully done to make everything work. It is a little+fragile and could at least do with some heavy explanation. Update: the+'try's have migrated into the individual parsers, they still need+documenting/fixing.+-}++scalarExpr :: Parser ScalarExpr+scalarExpr = E.makeExprParser term (opTable False)++term :: Parser ScalarExpr+term = choice [simpleLiteral+ ,parameter+ ,positionalArg+ ,star+ ,parensExpr+ ,caseExpr+ ,cast+ ,convertSqlServer+ ,arrayCtor+ ,multisetCtor+ ,nextValueFor+ ,subquery+ ,intervalLit+ ,specialOpKs+ ,idenExpr+ ,odbcExpr]+ <?> "scalar expression"++-- expose the b expression for window frame clause range between++scalarExprB :: Parser ScalarExpr+scalarExprB = E.makeExprParser term (opTable True)++{-+== helper parsers++This is used in interval literals and in interval type names.+-}++intervalQualifier :: Parser (IntervalTypeField,Maybe IntervalTypeField)+intervalQualifier =+ (,) <$> intervalField+ <*> optional (keyword_ "to" *> intervalField)+ where+ intervalField =+ Itf+ <$> datetimeField+ <*> optional+ (parens ((,) <$> unsignedInteger+ <*> optional (comma *> unsignedInteger)))++{-+TODO: use datetime field in extract also+use a data type for the datetime field?+-}++datetimeField :: Parser Text+datetimeField = choice (map keyword ["year","month","day"+ ,"hour","minute","second"])+ <?> "datetime field"++{-+This is used in multiset operations (scalar expr), selects (query expr)+and set operations (query expr).+-}++duplicates :: Parser SetQuantifier+duplicates =+ choice [All <$ keyword_ "all"+ ,Distinct <$ keyword "distinct"]++{-+-------------------------------------------------++= query expressions++== select lists+-}++selectItem :: Parser (ScalarExpr,Maybe Name)+selectItem = (,) <$> scalarExpr <*> optional als+ where als = optional (keyword_ "as") *> name++selectList :: Parser [(ScalarExpr,Maybe Name)]+selectList = commaSep1 selectItem++{-+== from++Here is the rough grammar for joins++tref+(cross | [natural] ([inner] | (left | right | full) [outer])) join+tref+[on expr | using (...)]++TODO: either use explicit 'operator precedence' parsers or build+expression parser for the 'tref operators' such as joins, lateral,+aliases.+-}++from :: Parser [TableRef]+from = keyword_ "from" *> commaSep1 tref+ where+ -- TODO: use P (a->) for the join tref suffix+ -- chainl or buildexpressionparser+ tref = (nonJoinTref <?> "table ref") >>= optionSuffix joinTrefSuffix+ nonJoinTref = choice+ [parens $ choice+ [TRQueryExpr <$> queryExpr+ ,TRParens <$> tref]+ ,TRLateral <$> (keyword_ "lateral"+ *> nonJoinTref)+ ,do+ n <- names+ choice [TRFunction n+ <$> parens (commaSep scalarExpr)+ ,pure $ TRSimple n]+ -- todo: I think you can only have outer joins inside the oj,+ -- not sure.+ ,TROdbc <$> (symbol "{" *> keyword_ "oj" *> tref <* symbol "}")+ ] <??> aliasSuffix+ aliasSuffix = fromAlias <$$> TRAlias+ joinTrefSuffix t =+ ((TRJoin t <$> option False (True <$ keyword_ "natural")+ <*> joinType+ <*> nonJoinTref+ <*> optional joinCondition)+ >>= optionSuffix joinTrefSuffix) <?> ""++{-+TODO: factor the join stuff to produce better error messages (and make+it more readable)+-}++joinType :: Parser JoinType+joinType = choice+ [JCross <$ keyword_ "cross" <* keyword_ "join"+ ,JInner <$ keyword_ "inner" <* keyword_ "join"+ ,JLeft <$ keyword_ "left"+ <* optional (keyword_ "outer")+ <* keyword_ "join"+ ,JRight <$ keyword_ "right"+ <* optional (keyword_ "outer")+ <* keyword_ "join"+ ,JFull <$ keyword_ "full"+ <* optional (keyword_ "outer")+ <* keyword_ "join"+ ,JInner <$ keyword_ "join"]++joinCondition :: Parser JoinCondition+joinCondition = choice+ [keyword_ "on" >> JoinOn <$> scalarExpr+ ,keyword_ "using" >> JoinUsing <$> parens (commaSep1 name)]++fromAlias :: Parser Alias+fromAlias = Alias <$> tableAlias <*> columnAliases+ where+ tableAlias = optional (keyword_ "as") *> name+ columnAliases = optional $ parens $ commaSep1 name++{-+== simple other parts++Parsers for where, group by, having, order by and limit, which are+pretty trivial.+-}++whereClause :: Parser ScalarExpr+whereClause = keyword_ "where" *> scalarExpr++groupByClause :: Parser [GroupingExpr]+groupByClause = keywords_ ["group","by"] *> commaSep1 groupingExpression+ where+ groupingExpression = choice+ [keyword_ "cube" >>+ Cube <$> parens (commaSep groupingExpression)+ ,keyword_ "rollup" >>+ Rollup <$> parens (commaSep groupingExpression)+ ,GroupingParens <$> parens (commaSep groupingExpression)+ ,keywords_ ["grouping", "sets"] >>+ GroupingSets <$> parens (commaSep groupingExpression)+ ,SimpleGroup <$> scalarExpr+ ]++having :: Parser ScalarExpr+having = keyword_ "having" *> scalarExpr++orderBy :: Parser [SortSpec]+orderBy = keywords_ ["order","by"] *> commaSep1 ob+ where+ ob = SortSpec+ <$> scalarExpr+ <*> option DirDefault (choice [Asc <$ keyword_ "asc"+ ,Desc <$ keyword_ "desc"])+ <*> option NullsOrderDefault+ -- todo: left factor better+ (keyword_ "nulls" >>+ choice [NullsFirst <$ keyword "first"+ ,NullsLast <$ keyword "last"])++{-+allows offset and fetch in either order++ postgresql offset without row(s) and limit instead of fetch also+-}++offsetFetch :: Parser (Maybe ScalarExpr, Maybe ScalarExpr)+offsetFetch =+ P.runPermutation $ (,) <$> maybePermutation offset <*> maybePermutation fetch+ where+ maybePermutation p = P.toPermutationWithDefault Nothing (Just <$> p)++offset :: Parser ScalarExpr+offset = keyword_ "offset" *> scalarExpr+ <* option () (choice [keyword_ "rows"+ ,keyword_ "row"])++fetch :: Parser ScalarExpr+fetch = fetchFirst <|> limit+ where+ fetchFirst = guardDialect diFetchFirst+ *> fs *> scalarExpr <* ro+ fs = makeKeywordTree ["fetch first", "fetch next"]+ ro = makeKeywordTree ["rows only", "row only"]+ -- todo: not in ansi sql dialect+ limit = guardDialect diLimit *>+ keyword_ "limit" *> scalarExpr++-- == common table expressions++with :: Parser QueryExpr+with = keyword_ "with" >>+ With <$> option False (True <$ keyword_ "recursive")+ <*> commaSep1 withQuery <*> queryExpr+ where+ withQuery = (,) <$> (withAlias <* keyword_ "as")+ <*> parens queryExpr+ withAlias = Alias <$> name <*> columnAliases+ columnAliases = optional $ parens $ commaSep1 name+++{-+== query expression++This parser parses any query expression variant: normal select, cte,+and union, etc..+-}++queryExpr :: Parser QueryExpr+queryExpr = E.makeExprParser qeterm qeOpTable+ where+ qeterm = with <|> select <|> table <|> values+ + select = keyword_ "select" >>+ mkSelect+ <$> option SQDefault duplicates+ <*> selectList+ <*> optional tableExpression <?> "table expression"+ mkSelect d sl Nothing =+ toQueryExpr $ makeSelect {msSetQuantifier = d, msSelectList = sl}+ mkSelect d sl (Just (TableExpression f w g h od ofs fe)) =+ Select d sl f w g h od ofs fe+ values = keyword_ "values"+ >> Values <$> commaSep (parens (commaSep scalarExpr))+ table = keyword_ "table" >> Table <$> names++ qeOpTable =+ [[E.InfixL $ setOp Intersect "intersect"]+ ,[E.InfixL $ setOp Except "except"+ ,E.InfixL $ setOp Union "union"]]+ setOp :: SetOperatorName -> Text -> Parser (QueryExpr -> QueryExpr -> QueryExpr)+ setOp ctor opName = (cq+ <$> (ctor <$ keyword_ opName)+ <*> option SQDefault duplicates+ <*> corr) <?> ""+ cq o d c q0 q1 = QueryExprSetOp q0 o d c q1+ corr = option Respectively (Corresponding <$ keyword_ "corresponding")++ +{-+local data type to help with parsing the bit after the select list,+called 'table expression' in the ansi sql grammar. Maybe this should+be in the public syntax?+-}++data TableExpression+ = TableExpression+ {_teFrom :: [TableRef]+ ,_teWhere :: Maybe ScalarExpr+ ,_teGroupBy :: [GroupingExpr]+ ,_teHaving :: Maybe ScalarExpr+ ,_teOrderBy :: [SortSpec]+ ,_teOffset :: Maybe ScalarExpr+ ,_teFetchFirst :: Maybe ScalarExpr}++tableExpression :: Parser TableExpression+tableExpression = mkTe <$> (from <?> "from clause")+ <*> (optional whereClause <?> "where clause")+ <*> (option [] groupByClause <?> "group by clause")+ <*> (optional having <?> "having clause")+ <*> (option [] orderBy <?> "order by clause")+ <*> (offsetFetch <?> "")+ where+ mkTe f w g h od (ofs,fe) =+ TableExpression f w g h od ofs fe++{-+wrapper for query expr which ignores optional trailing semicolon.++TODO: change style+-}++topLevelQueryExpr :: Parser QueryExpr+topLevelQueryExpr = queryExpr <??> (id <$ semi)++topLevelStatement :: Parser Statement+topLevelStatement = statement++{-+-------------------------++= Statements+-}++statementWithoutSemicolon :: Parser Statement+statementWithoutSemicolon = choice+ [keyword_ "create" *> choice [createSchema+ ,createTable+ ,createIndex+ ,createView+ ,createDomain+ ,createSequence+ ,createRole+ ,createAssertion]+ ,keyword_ "alter" *> choice [alterTable+ ,alterDomain+ ,alterSequence]+ ,keyword_ "drop" *> choice [dropSchema+ ,dropTable+ ,dropView+ ,dropDomain+ ,dropSequence+ ,dropRole+ ,dropAssertion]+ ,delete+ ,truncateSt+ ,insert+ ,update+ ,startTransaction+ ,savepoint+ ,releaseSavepoint+ ,commit+ ,rollback+ ,grant+ ,revoke+ ,SelectStatement <$> queryExpr+ ]++statement :: Parser Statement+statement = statementWithoutSemicolon <* optional semi <|> EmptyStatement <$ semi++createSchema :: Parser Statement+createSchema = keyword_ "schema" >>+ CreateSchema <$> names++createTable :: Parser Statement+createTable = do + d <- askDialect id+ let + parseColumnDef = TableColumnDef <$> columnDef + parseConstraintDef = uncurry TableConstraintDef <$> tableConstraintDef+ separator = if diNonCommaSeparatedConstraints d+ then optional comma+ else Just <$> comma+ constraints = sepBy parseConstraintDef separator+ entries = ((:) <$> parseColumnDef <*> ((comma >> entries) <|> pure [])) <|> constraints++ keyword_ "table" >>+ CreateTable+ <$> names + <*> parens entries++createIndex :: Parser Statement+createIndex =+ CreateIndex+ <$> ((keyword_ "index" >> pure False) <|>+ (keywords_ ["unique", "index"] >> pure True))+ <*> names+ <*> (keyword_ "on" >> names)+ <*> parens (commaSep1 name)++columnDef :: Parser ColumnDef+columnDef = ColumnDef <$> name <*> typeName+ <*> optional defaultClause+ <*> option [] (some colConstraintDef)+ where+ defaultClause = choice [+ keyword_ "default" >>+ DefaultClause <$> scalarExpr+ -- todo: left factor+ ,try (keywords_ ["generated","always","as"] >>+ GenerationClause <$> parens scalarExpr)+ ,keyword_ "generated" >>+ IdentityColumnSpec+ <$> (GeneratedAlways <$ keyword_ "always"+ <|> GeneratedByDefault <$ keywords_ ["by", "default"])+ <*> (keywords_ ["as", "identity"] *>+ option [] (parens sequenceGeneratorOptions))+ ]++tableConstraintDef :: Parser (Maybe [Name], TableConstraint)+tableConstraintDef =+ (,)+ <$> optional (keyword_ "constraint" *> names)+ <*> (unique <|> primaryKey <|> check <|> references)+ where+ unique = keyword_ "unique" >>+ TableUniqueConstraint <$> parens (commaSep1 name)+ primaryKey = keywords_ ["primary", "key"] >>+ TablePrimaryKeyConstraint <$> parens (commaSep1 name)+ check = keyword_ "check" >> TableCheckConstraint <$> parens scalarExpr+ references = keywords_ ["foreign", "key"] >>+ (\cs ft ftcs m (u,d) -> TableReferencesConstraint cs ft ftcs m u d)+ <$> parens (commaSep1 name)+ <*> (keyword_ "references" *> names)+ <*> optional (parens $ commaSep1 name)+ <*> refMatch+ <*> refActions++refMatch :: Parser ReferenceMatch+refMatch = option DefaultReferenceMatch+ (keyword_ "match" *>+ choice [MatchFull <$ keyword_ "full"+ ,MatchPartial <$ keyword_ "partial"+ ,MatchSimple <$ keyword_ "simple"])+refActions :: Parser (ReferentialAction,ReferentialAction)+refActions =+ P.runPermutation $ (,)+ <$> P.toPermutationWithDefault DefaultReferentialAction onUpdate+ <*> P.toPermutationWithDefault DefaultReferentialAction onDelete+ where+ -- todo: left factor?+ onUpdate = try (keywords_ ["on", "update"]) *> referentialAction+ onDelete = try (keywords_ ["on", "delete"]) *> referentialAction+ referentialAction = choice [+ RefCascade <$ keyword_ "cascade"+ -- todo: left factor?+ ,RefSetNull <$ try (keywords_ ["set", "null"])+ ,RefSetDefault <$ try (keywords_ ["set", "default"])+ ,RefRestrict <$ keyword_ "restrict"+ ,RefNoAction <$ keywords_ ["no", "action"]]++colConstraintDef :: Parser ColConstraintDef+colConstraintDef =+ ColConstraintDef+ <$> optional (keyword_ "constraint" *> names)+ <*> (nullable <|> notNull <|> unique <|> primaryKey <|> check <|> references)+ where+ nullable = ColNullableConstraint <$ keyword "null"+ notNull = ColNotNullConstraint <$ keywords_ ["not", "null"]+ unique = ColUniqueConstraint <$ keyword_ "unique"+ primaryKey = do+ keywords_ ["primary", "key"] + d <- askDialect id+ autoincrement <- if diAutoincrement d + then optional (keyword_ "autoincrement")+ else pure Nothing+ pure $ ColPrimaryKeyConstraint $ isJust autoincrement+ check = keyword_ "check" >> ColCheckConstraint <$> parens scalarExpr+ references = keyword_ "references" >>+ (\t c m (ou,od) -> ColReferencesConstraint t c m ou od)+ <$> names+ <*> optional (parens name)+ <*> refMatch+ <*> refActions++-- slightly hacky parser for signed integers++signedInteger :: Parser Integer+signedInteger =+ (*) <$> option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")+ <*> unsignedInteger++sequenceGeneratorOptions :: Parser [SequenceGeneratorOption]+sequenceGeneratorOptions =+ -- todo: could try to combine exclusive options+ -- such as cycle and nocycle+ -- sort out options which are sometimes not allowed+ -- as datatype, and restart with+ P.runPermutation ((\a b c d e f g h j k -> catMaybes [a,b,c,d,e,f,g,h,j,k])+ <$> maybePermutation startWith+ <*> maybePermutation dataType+ <*> maybePermutation restart+ <*> maybePermutation incrementBy+ <*> maybePermutation maxValue+ <*> maybePermutation noMaxValue+ <*> maybePermutation minValue+ <*> maybePermutation noMinValue+ <*> maybePermutation scycle+ <*> maybePermutation noCycle+ )+ where+ maybePermutation p = P.toPermutationWithDefault Nothing (Just <$> p)+ startWith = keywords_ ["start", "with"] >>+ SGOStartWith <$> signedInteger+ dataType = keyword_ "as" >>+ SGODataType <$> typeName+ restart = keyword_ "restart" >>+ SGORestart <$> optional (keyword_ "with" *> signedInteger)+ incrementBy = keywords_ ["increment", "by"] >>+ SGOIncrementBy <$> signedInteger+ maxValue = keyword_ "maxvalue" >>+ SGOMaxValue <$> signedInteger+ noMaxValue = SGONoMaxValue <$ try (keywords_ ["no","maxvalue"])+ minValue = keyword_ "minvalue" >>+ SGOMinValue <$> signedInteger+ noMinValue = SGONoMinValue <$ try (keywords_ ["no","minvalue"])+ scycle = SGOCycle <$ keyword_ "cycle"+ noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"])+++alterTable :: Parser Statement+alterTable = keyword_ "table" >>+ -- the choices have been ordered so that it works+ AlterTable <$> names <*> choice [addConstraint+ ,dropConstraint+ ,addColumnDef+ ,alterColumn+ ,dropColumn+ ]+ where+ addColumnDef = try (keyword_ "add"+ *> optional (keyword_ "column")) >>+ AddColumnDef <$> columnDef+ alterColumn = keyword_ "alter" >> optional (keyword_ "column") >>+ name <**> choice [setDefault+ ,dropDefault+ ,setNotNull+ ,dropNotNull+ ,setDataType]+ setDefault :: Parser (Name -> AlterTableAction)+ -- todo: left factor+ setDefault = try (keywords_ ["set","default"]) >>+ scalarExpr <$$> AlterColumnSetDefault+ dropDefault = AlterColumnDropDefault <$ try (keywords_ ["drop","default"])+ setNotNull = AlterColumnSetNotNull <$ try (keywords_ ["set","not","null"])+ dropNotNull = AlterColumnDropNotNull <$ try (keywords_ ["drop","not","null"])+ setDataType = try (keywords_ ["set","data","type"]) >>+ typeName <$$> AlterColumnSetDataType+ dropColumn = try (keyword_ "drop" *> optional (keyword_ "column")) >>+ DropColumn <$> name <*> dropBehaviour+ -- todo: left factor, this try is especially bad+ addConstraint = try (keyword_ "add" >>+ uncurry AddTableConstraintDef <$> tableConstraintDef)+ dropConstraint = try (keywords_ ["drop","constraint"]) >>+ DropTableConstraintDef <$> names <*> dropBehaviour+++dropSchema :: Parser Statement+dropSchema = keyword_ "schema" >>+ DropSchema <$> names <*> dropBehaviour++dropTable :: Parser Statement+dropTable = keyword_ "table" >>+ DropTable <$> names <*> dropBehaviour++createView :: Parser Statement+createView =+ CreateView+ <$> (option False (True <$ keyword_ "recursive") <* keyword_ "view")+ <*> names+ <*> optional (parens (commaSep1 name))+ <*> (keyword_ "as" *> queryExpr)+ <*> optional (choice [+ -- todo: left factor+ DefaultCheckOption <$ try (keywords_ ["with", "check", "option"])+ ,CascadedCheckOption <$ try (keywords_ ["with", "cascaded", "check", "option"])+ ,LocalCheckOption <$ try (keywords_ ["with", "local", "check", "option"])+ ])++dropView :: Parser Statement+dropView = keyword_ "view" >>+ DropView <$> names <*> dropBehaviour++createDomain :: Parser Statement+createDomain = keyword_ "domain" >>+ CreateDomain+ <$> names+ <*> (optional (keyword_ "as") *> typeName)+ <*> optional (keyword_ "default" *> scalarExpr)+ <*> many con+ where+ con = (,) <$> optional (keyword_ "constraint" *> names)+ <*> (keyword_ "check" *> parens scalarExpr)++alterDomain :: Parser Statement+alterDomain = keyword_ "domain" >>+ AlterDomain+ <$> names+ <*> (setDefault <|> constraint+ <|> (keyword_ "drop" *> (dropDefault <|> dropConstraint)))+ where+ setDefault = keywords_ ["set", "default"] >> ADSetDefault <$> scalarExpr+ constraint = keyword_ "add" >>+ ADAddConstraint+ <$> optional (keyword_ "constraint" *> names)+ <*> (keyword_ "check" *> parens scalarExpr)+ dropDefault = ADDropDefault <$ keyword_ "default"+ dropConstraint = keyword_ "constraint" >> ADDropConstraint <$> names++dropDomain :: Parser Statement+dropDomain = keyword_ "domain" >>+ DropDomain <$> names <*> dropBehaviour++createSequence :: Parser Statement+createSequence = keyword_ "sequence" >>+ CreateSequence+ <$> names+ <*> sequenceGeneratorOptions++alterSequence :: Parser Statement+alterSequence = keyword_ "sequence" >>+ AlterSequence+ <$> names+ <*> sequenceGeneratorOptions++dropSequence :: Parser Statement+dropSequence = keyword_ "sequence" >>+ DropSequence <$> names <*> dropBehaviour++createAssertion :: Parser Statement+createAssertion = keyword_ "assertion" >>+ CreateAssertion+ <$> names+ <*> (keyword_ "check" *> parens scalarExpr)+++dropAssertion :: Parser Statement+dropAssertion = keyword_ "assertion" >>+ DropAssertion <$> names <*> dropBehaviour++{-+-----------------++= dml+-}++delete :: Parser Statement+delete = keywords_ ["delete","from"] >>+ Delete+ <$> names+ <*> optional (optional (keyword_ "as") *> name)+ <*> optional (keyword_ "where" *> scalarExpr)++truncateSt :: Parser Statement+truncateSt = keywords_ ["truncate", "table"] >>+ Truncate+ <$> names+ <*> option DefaultIdentityRestart+ (ContinueIdentity <$ keywords_ ["continue","identity"]+ <|> RestartIdentity <$ keywords_ ["restart","identity"])++insert :: Parser Statement+insert = keywords_ ["insert", "into"] >>+ Insert+ <$> names+ <*> optional (parens $ commaSep1 name)+ <*> (DefaultInsertValues <$ keywords_ ["default", "values"]+ <|> InsertQuery <$> queryExpr)++update :: Parser Statement+update = keywords_ ["update"] >>+ Update+ <$> names+ <*> optional (optional (keyword_ "as") *> name)+ <*> (keyword_ "set" *> commaSep1 setClause)+ <*> optional (keyword_ "where" *> scalarExpr)+ where+ setClause = multipleSet <|> singleSet+ multipleSet = SetMultiple+ <$> parens (commaSep1 names)+ <*> (symbol "=" *> parens (commaSep1 scalarExpr))+ singleSet = Set+ <$> names+ <*> (symbol "=" *> scalarExpr)++dropBehaviour :: Parser DropBehaviour+dropBehaviour =+ option DefaultDropBehaviour+ (Restrict <$ keyword_ "restrict"+ <|> Cascade <$ keyword_ "cascade")++{-+-----------------------------++= transaction management+-}++startTransaction :: Parser Statement+startTransaction = StartTransaction <$ keywords_ ["start","transaction"]++savepoint :: Parser Statement+savepoint = keyword_ "savepoint" >>+ Savepoint <$> name++releaseSavepoint :: Parser Statement+releaseSavepoint = keywords_ ["release","savepoint"] >>+ ReleaseSavepoint <$> name++commit :: Parser Statement+commit = Commit <$ keyword_ "commit" <* optional (keyword_ "work")++rollback :: Parser Statement+rollback = keyword_ "rollback" >> optional (keyword_ "work") >>+ Rollback <$> optional (keywords_ ["to", "savepoint"] *> name)+++{-+------------------------------++= Access control++TODO: fix try at the 'on'+-}++grant :: Parser Statement+grant = keyword_ "grant" >> (try priv <|> role)+ where+ priv = GrantPrivilege+ <$> commaSep privilegeAction+ <*> (keyword_ "on" *> privilegeObject)+ <*> (keyword_ "to" *> commaSep name)+ <*> option WithoutGrantOption+ (WithGrantOption <$ keywords_ ["with","grant","option"])+ role = GrantRole+ <$> commaSep name+ <*> (keyword_ "to" *> commaSep name)+ <*> option WithoutAdminOption+ (WithAdminOption <$ keywords_ ["with","admin","option"])++createRole :: Parser Statement+createRole = keyword_ "role" >>+ CreateRole <$> name++dropRole :: Parser Statement+dropRole = keyword_ "role" >>+ DropRole <$> name++-- TODO: fix try at the 'on'++revoke :: Parser Statement+revoke = keyword_ "revoke" >> (try priv <|> role)+ where+ priv = RevokePrivilege+ <$> option NoGrantOptionFor+ (GrantOptionFor <$ keywords_ ["grant","option","for"])+ <*> commaSep privilegeAction+ <*> (keyword_ "on" *> privilegeObject)+ <*> (keyword_ "from" *> commaSep name)+ <*> dropBehaviour+ role = RevokeRole+ <$> option NoAdminOptionFor+ (AdminOptionFor <$ keywords_ ["admin","option", "for"])+ <*> commaSep name+ <*> (keyword_ "from" *> commaSep name)+ <*> dropBehaviour++privilegeAction :: Parser PrivilegeAction+privilegeAction = choice+ [PrivAll <$ keywords_ ["all","privileges"]+ ,keyword_ "select" >>+ PrivSelect <$> option [] (parens $ commaSep name)+ ,PrivDelete <$ keyword_ "delete"+ ,PrivUsage <$ keyword_ "usage"+ ,PrivTrigger <$ keyword_ "trigger"+ ,PrivExecute <$ keyword_ "execute"+ ,keyword_ "insert" >>+ PrivInsert <$> option [] (parens $ commaSep name)+ ,keyword_ "update" >>+ PrivUpdate <$> option [] (parens $ commaSep name)+ ,keyword_ "references" >>+ PrivReferences <$> option [] (parens $ commaSep name)+ ]++privilegeObject :: Parser PrivilegeObject+privilegeObject = choice+ [keyword_ "domain" >> PrivDomain <$> names+ ,keyword_ "type" >> PrivType <$> names+ ,keyword_ "sequence" >> PrivSequence <$> names+ ,keywords_ ["specific","function"] >> PrivFunction <$> names+ ,optional (keyword_ "table") >> PrivTable <$> names+ ]+++{-+----------------------------++wrapper to parse a series of statements. They must be separated by+semicolon, but for the last statement, the trailing semicolon is+optional.+-}++statements :: Parser [Statement]+statements = many statement++{-+----------------------------------------------++= multi keyword helper++This helper is to help parsing multiple options of multiple keywords+with similar prefixes, e.g. parsing 'is null' and 'is not null'.++use to left factor/ improve:+typed literal and general identifiers+not like, not in, not between operators+help with factoring keyword functions and other app-likes+the join keyword sequences+fetch first/next+row/rows only++There is probably a simpler way of doing this but I am a bit+thick.+-}++makeKeywordTree :: [Text] -> Parser [Text]+makeKeywordTree sets =+ parseTrees (sort $ map T.words sets)+ where+ parseTrees :: [[Text]] -> Parser [Text]+ parseTrees ws = do+ let gs :: [[[Text]]]+ gs = groupBy ((==) `on` safeHead) ws+ choice $ map parseGroup gs+ parseGroup :: [[Text]] -> Parser [Text]+ parseGroup l@((k:_):_) = do+ keyword_ k+ let tls = mapMaybe safeTail l+ pr = (k:) <$> parseTrees tls+ if any null tls+ then pr <|> pure [k]+ else pr+ parseGroup _ = guard False >> fail "impossible"+ safeHead (x:_) = Just x+ safeHead [] = Nothing+ safeTail (_:x) = Just x+ safeTail [] = Nothing++------------------------------------------------------------------------------++-- parser helpers++(<$$>) :: Applicative f =>+ f b -> (a -> b -> c) -> f (a -> c)+(<$$>) pa c = pa <**> pure (flip c)++(<$$$>) :: Applicative f =>+ f c -> (a -> b -> c -> t) -> f (b -> a -> t)+p <$$$> c = p <**> pure (flip3 c)++(<$$$$>) :: Applicative f =>+ f d -> (a -> b -> c -> d -> t) -> f (c -> b -> a -> t)+p <$$$$> c = p <**> pure (flip4 c)++(<$$$$$>) :: Applicative f =>+ f e -> (a -> b -> c -> d -> e -> t) -> f (d -> c -> b -> a -> t)+p <$$$$$> c = p <**> pure (flip5 c)++optionSuffix :: (a -> Parser a) -> a -> Parser a+optionSuffix p a = option a (p a)++{-+parses an optional postfix element and applies its result to its left+hand result, taken from uu-parsinglib++TODO: make sure the precedence higher than <|> and lower than the+other operators so it can be used nicely+-}++(<??>) :: Parser a -> Parser (a -> a) -> Parser a+p <??> q = p <**> option id q++-- 0 to many repeated applications of suffix parser++(<??*>) :: Parser a -> Parser (a -> a) -> Parser a+p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)++{-+These are to help with left factored parsers:++a <**> (b <**> (c <**> pure (flip3 ctor)))++Not sure the names are correct, but they follow a pattern with flip+a <**> (b <**> pure (flip ctor))+-}++flip3 :: (a -> b -> c -> t) -> c -> b -> a -> t+flip3 f a b c = f c b a++flip4 :: (a -> b -> c -> d -> t) -> d -> c -> b -> a -> t+flip4 f a b c d = f d c b a++flip5 :: (a -> b -> c -> d -> e -> t) -> e -> d -> c -> b -> a -> t+flip5 f a b c d e = f e d c b a++--------------------------------------++unsignedInteger :: Parser Integer+unsignedInteger = read . T.unpack <$> sqlNumberTok True <?> "natural number"++-- todo: work out the symbol parsing better++symbol :: Text -> Parser Text+symbol s = symbolTok (Just s) <?> T.unpack s++singleCharSymbol :: Char -> Parser Char+singleCharSymbol c = c <$ symbol (T.singleton c)++questionMark :: Parser Char+questionMark = singleCharSymbol '?' <?> "question mark"++openParen :: Parser Char+openParen = singleCharSymbol '('++closeParen :: Parser Char+closeParen = singleCharSymbol ')'++openBracket :: Parser Char+openBracket = singleCharSymbol '['++closeBracket :: Parser Char+closeBracket = singleCharSymbol ']'+++comma :: Parser Char+comma = singleCharSymbol ',' <?> ""++semi :: Parser Char+semi = singleCharSymbol ';' <?> ""++-- = helper functions++keyword :: Text -> Parser Text+keyword k = unquotedIdentifierTok [] (Just k) <?> T.unpack k++-- helper function to improve error messages++keywords_ :: [Text] -> Parser ()+keywords_ ks = mapM_ keyword_ ks <?> T.unpack (T.unwords ks)+++parens :: Parser a -> Parser a+parens = between openParen closeParen++brackets :: Parser a -> Parser a+brackets = between openBracket closeBracket++commaSep :: Parser a -> Parser [a]+commaSep = (`sepBy` comma)++keyword_ :: Text -> Parser ()+keyword_ = void . keyword++symbol_ :: Text -> Parser ()+symbol_ = void . symbol++commaSep1 :: Parser a -> Parser [a]+commaSep1 = (`sepBy1` comma)++------------------------------------------------------------------------------++-- interfacing with the lexing+{-+TODO: push checks into here:+keyword blacklists+unsigned integer match+symbol matching+keyword matching++-}+stringTok :: Parser (Text,Text,Text)+stringTok = token test Set.empty <?> "string literal"+ where+ test (L.WithPos _ _ _ (L.SqlString s e t)) = Just (s,e,t)+ test _ = Nothing++singleQuotesOnlyStringTok :: Parser Text+singleQuotesOnlyStringTok = token test Set.empty <?> "string literal"+ where+ test (L.WithPos _ _ _ (L.SqlString "'" "'" t)) = Just t+ test _ = Nothing++{-+This is to support SQL strings where you can write+'part of a string' ' another part'+and it will parse as a single string++It is only allowed when all the strings are quoted with ' atm.+-}++stringTokExtend :: Parser (Text,Text,Text)+stringTokExtend = do+ (s,e,x) <- stringTok+ choice [+ do+ guard (s == "'" && e == "'")+ (s',e',y) <- stringTokExtend+ guard (s' == "'" && e' == "'")+ pure (s,e,x <> y)+ ,pure (s,e,x)+ ]++hostParamTok :: Parser Text+hostParamTok = token test Set.empty <?> ""+ where+ test (L.WithPos _ _ _ (L.PrefixedVariable c p)) = Just $ T.cons c p+ test _ = Nothing++positionalArgTok :: Parser Int+positionalArgTok = token test Set.empty <?> ""+ where+ test (L.WithPos _ _ _ (L.PositionalArg p)) = Just p+ test _ = Nothing++sqlNumberTok :: Bool -> Parser Text+sqlNumberTok intOnly = token test Set.empty <?> ""+ where+ test (L.WithPos _ _ _ (L.SqlNumber p)) | not intOnly || T.all isDigit p = Just p+ test _ = Nothing++symbolTok :: Maybe Text -> Parser Text+symbolTok sym = token test Set.empty <?> ""+ where+ test (L.WithPos _ _ _ (L.Symbol p)) =+ case sym of+ Nothing -> Just p+ Just sym' | sym' == p -> Just p+ _ -> Nothing+ test _ = Nothing++{-+The blacklisted names are mostly needed when we parse something with+an optional alias, e.g. select a a from t. If we write select a from+t, we have to make sure the from isn't parsed as an alias. I'm not+sure what other places strictly need the blacklist, and in theory it+could be tuned differently for each place the identifierString/+identifier parsers are used to only blacklist the bare+minimum. Something like this might be needed for dialect support, even+if it is pretty silly to use a keyword as an unquoted identifier when+there is a quoting syntax as well.++The standard has a weird mix of reserved keywords and unreserved+keywords (I'm not sure what exactly being an unreserved keyword+means).++The current approach tries to have everything which is a keyword only+in the keyword list - so it can only be used in some other context if+quoted. If something is a 'ansi keyword', but appears only as an+identifier or function name for instance in the syntax (or something+that looks identical to this), then it isn't treated as a keyword at+all. When there is some overlap (e.g. 'set'), then there is either+special case parsing code to handle this (in the case of set), or it+is not treated as a keyword (not perfect, but if it more or less+works, ok for now).++An exception to this is the standard type names are considered as+keywords at the moment, with a special case in the type parser to+make this work. Maybe this isn't necessary or is a bad idea.++It is possible to have a problem if you remove something which is a+keyword from this list, and still want to parse statements using it+as a keyword - for instance, removing things like 'from' or 'as',+will likely mean many things don't parse anymore.++-}++identifierTok :: [Text] -> Parser (Maybe (Text,Text), Text)+identifierTok blackList = token test Set.empty <?> ""+ where+ test (L.WithPos _ _ _ (L.Identifier q@(Just {}) p)) = Just (q,p)+ test (L.WithPos _ _ _ (L.Identifier q p))+ | T.toLower p `notElem` blackList = Just (q,p)+ test _ = Nothing++unquotedIdentifierTok :: [Text] -> Maybe Text -> Parser Text+unquotedIdentifierTok blackList kw = token test Set.empty <?> ""+ where+ test (L.WithPos _ _ _ (L.Identifier Nothing p)) =+ case kw of+ Nothing | T.toLower p `notElem` blackList -> Just p+ Just k | k == T.toLower p -> Just p+ _ -> Nothing+ test _ = Nothing++------------------------------------------------------------------------------++-- dialect++guardDialect :: (Dialect -> Bool) -> Parser ()+guardDialect p = guard . p =<< ask++askDialect :: (Dialect -> a) -> Parser a+askDialect = asks+
− Language/SQL/SimpleSQL/Parse.lhs
@@ -1,2152 +0,0 @@--= TOC:--notes-Public api-Names - parsing identifiers-Typenames-Scalar expressions- simple literals- star, param- parens expression, row constructor and scalar subquery- case, cast, exists, unique, array/ multiset constructor- typed literal, app, special function, aggregate, window function- suffixes: in, between, quantified comparison, match predicate, array- subscript, escape, collate- operators- scalar expression top level- helpers-query expressions- select lists- from clause- other table expression clauses:- where, group by, having, order by, offset and fetch- common table expressions- query expression- set operations-lexers-utilities--= Notes about the code--The lexers appear at the bottom of the file. There tries to be a clear-separation between the lexers and the other parser which only use the-lexers, this isn't 100% complete at the moment and needs fixing.--== Left factoring--The parsing code is aggressively left factored, and try is avoided as-much as possible. Try is avoided because:-- * when it is overused it makes the code hard to follow- * when it is overused it makes the parsing code harder to debug- * it makes the parser error messages much worse--The code could be made a bit simpler with a few extra 'trys', but this-isn't done because of the impact on the parser error-messages. Apparently it can also help the speed but this hasn't been-looked into.--== Parser error messages--A lot of care has been given to generating good parser error messages-for invalid syntax. There are a few utils below which partially help-in this area.--There is a set of crafted bad expressions in ErrorMessages.lhs, these-are used to guage the quality of the error messages and monitor-regressions by hand. The use of <?> is limited as much as possible:-each instance should justify itself by improving an actual error-message.--There is also a plan to write a really simple expression parser which-doesn't do precedence and associativity, and the fix these with a pass-over the ast. I don't think there is any other way to sanely handle-the common prefixes between many infix and postfix multiple keyword-operators, and some other ambiguities also. This should help a lot in-generating good error messages also.--Both the left factoring and error message work are greatly complicated-by the large number of shared prefixes of the various elements in SQL-syntax.--== Main left factoring issues--There are three big areas which are tricky to left factor:-- * typenames- * scalar expressions which can start with an identifier- * infix and suffix operators--=== typenames--There are a number of variations of typename syntax. The standard-deals with this by switching on the name of the type which is parsed-first. This code doesn't do this currently, but might in the-future. Taking the approach in the standard grammar will limit the-extensibility of the parser and might affect the ease of adapting to-support other sql dialects.--=== identifier scalar expressions--There are a lot of scalar expression nodes which start with-identifiers, and can't be distinguished the tokens after the initial-identifier are parsed. Using try to implement these variations is very-simple but makes the code much harder to debug and makes the parser-error messages really bad.--Here is a list of these nodes:-- * identifiers- * function application- * aggregate application- * window application- * typed literal: typename 'literal string'- * interval literal which is like the typed literal with some extras--There is further ambiguity e.g. with typed literals with precision,-functions, aggregates, etc. - these are an identifier, followed by-parens comma separated scalar expressions or something similar, and it-is only later that we can find a token which tells us which flavour it-is.--There is also a set of nodes which start with an identifier/keyword-but can commit since no other syntax can start the same way:-- * case- * cast- * exists, unique subquery- * array constructor- * multiset constructor- * all the special syntax functions: extract, position, substring,- convert, translate, overlay, trim, etc.--The interval literal mentioned above is treated in this group at the-moment: if we see 'interval' we parse it either as a full interval-literal or a typed literal only.--Some items in this list might have to be fixed in the future, e.g. to-support standard 'substring(a from 3 for 5)' as well as regular-function substring syntax 'substring(a,3,5) at the same time.--The work in left factoring all this is mostly done, but there is still-a substantial bit to complete and this is by far the most difficult-bit. At the moment, the work around is to use try, the downsides of-which is the poor parsing error messages.--=== infix and suffix operators--== permissiveness--The parser is very permissive in many ways. This departs from the-standard which is able to eliminate a number of possibilities just in-the grammar, which this parser allows. This is done for a number of-reasons:-- * it makes the parser simple - less variations- * it should allow for dialects and extensibility more easily in the- future (e.g. new infix binary operators with custom precedence)- * many things which are effectively checked in the grammar in the- standard, can be checked using a typechecker or other simple static- analysis--To use this code as a front end for a sql engine, or as a sql validity-checker, you will need to do a lot of checks on the ast. A-typechecker/static checker plus annotation to support being a compiler-front end is planned but not likely to happen too soon.--Some of the areas this affects:--typenames: the variation of the type name should switch on the actual-name given according to the standard, but this code only does this for-the special case of interval type names. E.g. you can write 'int-collate C' or 'int(15,2)' and this will parse as a character type name-or a precision scale type name instead of being rejected.--scalar expressions: every variation on scalar expressions uses the same-parser/syntax. This means we don't try to stop non boolean valued-expressions in boolean valued contexts in the parser. Another area-this affects is that we allow general scalar expressions in group by,-whereas the standard only allows column names with optional collation.--These are all areas which are specified (roughly speaking) in the-syntax rather than the semantics in the standard, and we are not-fixing them in the syntax but leaving them till the semantic checking-(which doesn't exist in this code at this time).--> {-# LANGUAGE TupleSections #-}-> -- | This is the module with the parser functions.-> module Language.SQL.SimpleSQL.Parse-> (parseQueryExpr-> ,parseScalarExpr-> ,parseStatement-> ,parseStatements-> ,ParseError(..)) where--> import Control.Monad.Identity (Identity)-> import Control.Monad (guard, void)-> import Control.Applicative ((<**>))-> import Data.Char (toLower, isDigit)-> import Text.Parsec (setPosition,setSourceColumn,setSourceLine,getPosition-> ,option,between,sepBy,sepBy1-> ,try,many,many1,(<|>),choice,eof-> ,optionMaybe,optional,runParser-> ,chainl1, chainr1,(<?>))-> import Text.Parsec.Perm (permute,(<$?>), (<|?>))-> import Text.Parsec.Prim (getState, token)-> import Text.Parsec.Pos (newPos)-> import qualified Text.Parsec.Expr as E-> import Data.List (intercalate,sort,groupBy)-> import Data.Function (on)-> import Data.Maybe-> import Text.Parsec.String (GenParser)--> import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Combinators-> import Language.SQL.SimpleSQL.Errors-> import Language.SQL.SimpleSQL.Dialect-> import qualified Language.SQL.SimpleSQL.Lex as L---= Public API--> -- | Parses a query expr, trailing semicolon optional.-> parseQueryExpr :: Dialect-> -- ^ dialect of SQL to use-> -> FilePath-> -- ^ filename to use in error messages-> -> Maybe (Int,Int)-> -- ^ line number and column number of the first character-> -- in the source to use in error messages-> -> String-> -- ^ the SQL source to parse-> -> Either ParseError QueryExpr-> parseQueryExpr = wrapParse topLevelQueryExpr--> -- | Parses a statement, trailing semicolon optional.-> parseStatement :: Dialect-> -- ^ dialect of SQL to use-> -> FilePath-> -- ^ filename to use in error messages-> -> Maybe (Int,Int)-> -- ^ line number and column number of the first character-> -- in the source to use in error messages-> -> String-> -- ^ the SQL source to parse-> -> Either ParseError Statement-> parseStatement = wrapParse topLevelStatement---> -- | Parses a list of statements, with semi colons between-> -- them. The final semicolon is optional.-> parseStatements :: Dialect-> -- ^ dialect of SQL to use-> -> FilePath-> -- ^ filename to use in error messages-> -> Maybe (Int,Int)-> -- ^ line number and column number of the first character-> -- in the source to use in error messages-> -> String-> -- ^ the SQL source to parse-> -> Either ParseError [Statement]-> parseStatements = wrapParse statements--> -- | Parses a scalar expression.-> parseScalarExpr :: Dialect-> -- ^ dialect of SQL to use-> -> FilePath-> -- ^ filename to use in error messages-> -> Maybe (Int,Int)-> -- ^ line number and column number of the first character-> -- in the source to use in error messages-> -> String-> -- ^ the SQL source to parse-> -> Either ParseError ScalarExpr-> parseScalarExpr = wrapParse scalarExpr--This helper function takes the parser given and:--sets the position when parsing-automatically skips leading whitespace-checks the parser parses all the input using eof-converts the error return to the nice wrapper--> wrapParse :: Parser a-> -> Dialect-> -> FilePath-> -> Maybe (Int,Int)-> -> String-> -> Either ParseError a-> wrapParse parser d f p src = do-> let (l,c) = fromMaybe (1,1) p-> lx <- L.lexSQL d f (Just (l,c)) src-> either (Left . convParseError src) Right-> $ runParser (setPos p *> parser <* eof)-> d f $ filter keep lx-> where-> setPos Nothing = pure ()-> setPos (Just (l,c)) = fmap up getPosition >>= setPosition-> where up = flip setSourceColumn c . flip setSourceLine l-> keep (_,L.Whitespace {}) = False-> keep (_,L.LineComment {}) = False-> keep (_,L.BlockComment {}) = False-> keep _ = True-----------------------------------------------------= Names--Names represent identifiers and a few other things. The parser here-handles regular identifiers, dotten chain identifiers, quoted-identifiers and unicode quoted identifiers.--Dots: dots in identifier chains are parsed here and represented in the-Iden constructor usually. If parts of the chains are non identifier-scalar expressions, then this is represented by a BinOp "."-instead. Dotten chain identifiers which appear in other contexts (such-as function names, table names, are represented as [Name] only.--Identifier grammar:--unquoted:-underscore <|> letter : many (underscore <|> alphanum--example-_example123--quoted:--double quote, many (non quote character or two double quotes-together), double quote--"example quoted"-"example with "" quote"--unicode quoted is the same as quoted in this parser, except it starts-with U& or u&--u&"example quoted"--> name :: Parser Name-> name = do-> d <- getState-> uncurry Name <$> identifierTok (blacklist d)--todo: replace (:[]) with a named function all over--> names :: Parser [Name]-> names = reverse <$> (((:[]) <$> name) <??*> anotherName)-> -- can't use a simple chain here since we-> -- want to wrap the . + name in a try-> -- this will change when this is left factored-> where-> anotherName :: Parser ([Name] -> [Name])-> anotherName = try ((:) <$> (symbol "." *> name))--= Type Names--Typenames are used in casts, and also in the typed literal syntax,-which is a typename followed by a string literal.--Here are the grammar notes:--== simple type name--just an identifier chain or a multi word identifier (this is a fixed-list of possibilities, e.g. as 'character varying', see below in the-parser code for the exact list).--<simple-type-name> ::= <identifier-chain>- | multiword-type-identifier--== Precision type name--<precision-type-name> ::= <simple-type-name> <left paren> <unsigned-int> <right paren>--e.g. char(5)--note: above and below every where a simple type name can appear, this-means a single identifier/quoted or a dotted chain, or a multi word-identifier--== Precision scale type name--<precision-type-name> ::= <simple-type-name> <left paren> <unsigned-int> <comma> <unsigned-int> <right paren>--e.g. decimal(15,2)--== Lob type name--this is a variation on the precision type name with some extra info on-the units:--<lob-type-name> ::=- <simple-type-name> <left paren> <unsigned integer> [ <multiplier> ] [ <char length units> ] <right paren>--<multiplier> ::= K | M | G-<char length units> ::= CHARACTERS | CODE_UNITS | OCTETS--(if both multiplier and char length units are missing, then this will-parse as a precision type name)--e.g.-clob(5M octets)--== char type name--this is a simple type with optional precision which allows the-character set or the collation to appear as a suffix:--<char type name> ::=- <simple type name>- [ <left paren> <unsigned-int> <right paren> ]- [ CHARACTER SET <identifier chain> ]- [ COLLATE <identifier chain> ]--e.g.--char(5) character set my_charset collate my_collation--= Time typename--this is typename with optional precision and either 'with time zone'-or 'without time zone' suffix, e.g.:--<datetime type> ::=- [ <left paren> <unsigned-int> <right paren> ]- <with or without time zone>-<with or without time zone> ::= WITH TIME ZONE | WITHOUT TIME ZONE- WITH TIME ZONE | WITHOUT TIME ZONE--= row type name--<row type> ::=- ROW <left paren> <field definition> [ { <comma> <field definition> }... ] <right paren>--<field definition> ::= <identifier> <type name>--e.g.-row(a int, b char(5))--= interval type name--<interval type> ::= INTERVAL <interval datetime field> [TO <interval datetime field>]--<interval datetime field> ::=- <datetime field> [ <left paren> <unsigned int> [ <comma> <unsigned int> ] <right paren> ]--= array type name--<array type> ::= <data type> ARRAY [ <left bracket> <unsigned integer> <right bracket> ]--= multiset type name--<multiset type> ::= <data type> MULTISET--A type name will parse into the 'smallest' constructor it will fit in-syntactically, e.g. a clob(5) will parse to a precision type name, not-a lob type name.--Unfortunately, to improve the error messages, there is a lot of (left)-factoring in this function, and it is a little dense.--> typeName :: Parser TypeName-> typeName =-> (rowTypeName <|> intervalTypeName <|> otherTypeName)-> <??*> tnSuffix-> where-> rowTypeName =-> RowTypeName <$> (keyword_ "row" *> parens (commaSep1 rowField))-> rowField = (,) <$> name <*> typeName-> -----------------------------> intervalTypeName =-> keyword_ "interval" *>-> (uncurry IntervalTypeName <$> intervalQualifier)-> -----------------------------> otherTypeName =-> nameOfType <**>-> (typeNameWithParens-> <|> pure Nothing <**> (timeTypeName <|> charTypeName)-> <|> pure TypeName)-> nameOfType = reservedTypeNames <|> names-> charTypeName = charSet <**> (option [] tcollate <$$$$> CharTypeName)-> <|> pure [] <**> (tcollate <$$$$> CharTypeName)-> typeNameWithParens =-> (openParen *> unsignedInteger)-> <**> (closeParen *> precMaybeSuffix-> <|> (precScaleTypeName <|> precLengthTypeName) <* closeParen)-> precMaybeSuffix = (. Just) <$> (timeTypeName <|> charTypeName)-> <|> pure (flip PrecTypeName)-> precScaleTypeName = (comma *> unsignedInteger) <$$$> PrecScaleTypeName-> precLengthTypeName =-> Just <$> lobPrecSuffix-> <**> (optionMaybe lobUnits <$$$$> PrecLengthTypeName)-> <|> pure Nothing <**> ((Just <$> lobUnits) <$$$$> PrecLengthTypeName)-> timeTypeName = tz <$$$> TimeTypeName-> -----------------------------> lobPrecSuffix = PrecK <$ keyword_ "k"-> <|> PrecM <$ keyword_ "m"-> <|> PrecG <$ keyword_ "g"-> <|> PrecT <$ keyword_ "t"-> <|> PrecP <$ keyword_ "p"-> lobUnits = PrecCharacters <$ keyword_ "characters"-> -- char and byte are the oracle spelling-> -- todo: move these to oracle dialect-> <|> PrecCharacters <$ keyword_ "char"-> <|> PrecOctets <$ keyword_ "octets"-> <|> PrecOctets <$ keyword_ "byte"-> tz = True <$ keywords_ ["with", "time","zone"]-> <|> False <$ keywords_ ["without", "time","zone"]-> charSet = keywords_ ["character", "set"] *> names-> tcollate = keyword_ "collate" *> names-> -----------------------------> tnSuffix = multiset <|> array-> multiset = MultisetTypeName <$ keyword_ "multiset"-> array = keyword_ "array" *>-> (optionMaybe (brackets unsignedInteger) <$$> ArrayTypeName)-> -----------------------------> -- this parser handles the fixed set of multi word-> -- type names, plus all the type names which are-> -- reserved words-> reservedTypeNames = do-> d <- getState-> (:[]) . Name Nothing . unwords <$> makeKeywordTree (diSpecialTypeNames d)-> --= Scalar expressions--== simple literals--See the stringToken lexer below for notes on string literal syntax.--> stringLit :: Parser ScalarExpr-> stringLit = (\(s,e,t) -> StringLit s e t) <$> stringTokExtend--> numberLit :: Parser ScalarExpr-> numberLit = NumLit <$> sqlNumberTok False--> simpleLiteral :: Parser ScalarExpr-> simpleLiteral = numberLit <|> stringLit--== star, param, host param--=== star--used in select *, select x.*, and agg(*) variations, and some other-places as well. The parser doesn't attempt to check that the star is-in a valid context, it parses it OK in any scalar expression context.--> star :: Parser ScalarExpr-> star = Star <$ symbol "*"--== parameter--unnamed parameter or named parameter-use in e.g. select * from t where a = ?-select x from t where x > :param--> parameter :: Parser ScalarExpr-> parameter = choice-> [Parameter <$ questionMark-> ,HostParameter-> <$> hostParamTok-> <*> optionMaybe (keyword "indicator" *> hostParamTok)]--== positional arg--> positionalArg :: Parser ScalarExpr-> positionalArg = PositionalArg <$> positionalArgTok--== parens--scalar expression parens, row ctor and scalar subquery--> parensExpr :: Parser ScalarExpr-> parensExpr = parens $ choice-> [SubQueryExpr SqSq <$> queryExpr-> ,ctor <$> commaSep1 scalarExpr]-> where-> ctor [a] = Parens a-> ctor as = SpecialOp [Name Nothing "rowctor"] as--== case, cast, exists, unique, array/multiset constructor, interval--All of these start with a fixed keyword which is reserved, so no other-syntax can start with the same keyword.--=== case expression--> caseExpr :: Parser ScalarExpr-> caseExpr =-> Case <$> (keyword_ "case" *> optionMaybe scalarExpr)-> <*> many1 whenClause-> <*> optionMaybe elseClause-> <* keyword_ "end"-> where-> whenClause = (,) <$> (keyword_ "when" *> commaSep1 scalarExpr)-> <*> (keyword_ "then" *> scalarExpr)-> elseClause = keyword_ "else" *> scalarExpr--=== cast--cast: cast(expr as type)--> cast :: Parser ScalarExpr-> cast = keyword_ "cast" *>-> parens (Cast <$> scalarExpr-> <*> (keyword_ "as" *> typeName))--=== exists, unique--subquery expression:-[exists|unique] (queryexpr)--> subquery :: Parser ScalarExpr-> subquery = SubQueryExpr <$> sqkw <*> parens queryExpr-> where-> sqkw = SqExists <$ keyword_ "exists" <|> SqUnique <$ keyword_ "unique"--=== array/multiset constructor--> arrayCtor :: Parser ScalarExpr-> arrayCtor = keyword_ "array" >>-> choice-> [ArrayCtor <$> parens queryExpr-> ,Array (Iden [Name Nothing "array"]) <$> brackets (commaSep scalarExpr)]--As far as I can tell, table(query expr) is just syntax sugar for-multiset(query expr). It must be there for compatibility or something.--> multisetCtor :: Parser ScalarExpr-> multisetCtor =-> choice-> [keyword_ "multiset" >>-> choice-> [MultisetQueryCtor <$> parens queryExpr-> ,MultisetCtor <$> brackets (commaSep scalarExpr)]-> ,keyword_ "table" >>-> MultisetQueryCtor <$> parens queryExpr]--> nextValueFor :: Parser ScalarExpr-> nextValueFor = keywords_ ["next","value","for"] >>-> NextValueFor <$> names--=== interval--interval literals are a special case and we follow the grammar less-permissively here--parse SQL interval literals, something like-interval '5' day (3)-or-interval '5' month--if the literal looks like this:-interval 'something'--then it is parsed as a regular typed literal. It must have a-interval-datetime-field suffix to parse as an intervallit--It uses try because of a conflict with interval type names: todo, fix-this. also fix the monad -> applicative--> intervalLit :: Parser ScalarExpr-> intervalLit = try (keyword_ "interval" >> do-> s <- optionMaybe $ choice [Plus <$ symbol_ "+"-> ,Minus <$ symbol_ "-"]-> lit <- singleQuotesOnlyStringTok-> q <- optionMaybe intervalQualifier-> mkIt s lit q)-> where-> mkIt Nothing val Nothing = pure $ TypedLit (TypeName [Name Nothing "interval"]) val-> mkIt s val (Just (a,b)) = pure $ IntervalLit s val a b-> mkIt (Just {}) _val Nothing = fail "cannot use sign without interval qualifier"--== typed literal, app, special, aggregate, window, iden--All of these start with identifiers (some of the special functions-start with reserved keywords).--they are all variations on suffixes on the basic identifier parser--The windows is a suffix on the app parser--=== iden prefix term--all the scalar expressions which start with an identifier--(todo: really put all of them here instead of just some of them)--> idenExpr :: Parser ScalarExpr-> idenExpr =-> -- todo: work out how to left factor this-> try (TypedLit <$> typeName <*> singleQuotesOnlyStringTok)-> <|> (names <**> option Iden app)-> <|> keywordFunctionOrIden-> where-> -- special cases for keywords that can be parsed as an iden or app-> keywordFunctionOrIden = try $ do-> x <- unquotedIdentifierTok [] Nothing-> d <- getState-> let i = map toLower x `elem` diIdentifierKeywords d-> a = map toLower x `elem` diAppKeywords d-> case () of-> _ | i && a -> pure [Name Nothing x] <**> option Iden app-> | i -> pure (Iden [Name Nothing x])-> | a -> pure [Name Nothing x] <**> app-> | otherwise -> fail ""---=== special--These are keyword operators which don't look like normal prefix,-postfix or infix binary operators. They mostly look like function-application but with keywords in the argument list instead of commas-to separate the arguments.--the special op keywords-parse an operator which is-operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)--> data SpecialOpKFirstArg = SOKNone-> | SOKOptional-> | SOKMandatory--> specialOpK :: String -- name of the operator-> -> SpecialOpKFirstArg -- has a first arg without a keyword-> -> [(String,Bool)] -- the other args with their keywords-> -- and whether they are optional-> -> Parser ScalarExpr-> specialOpK opName firstArg kws =-> keyword_ opName >> do-> void openParen-> let pfa = do-> e <- scalarExpr-> -- check we haven't parsed the first-> -- keyword as an identifier-> case (e,kws) of-> (Iden [Name Nothing i], (k,_):_)-> | map toLower i == k ->-> fail $ "cannot use keyword here: " ++ i-> _ -> return ()-> pure e-> fa <- case firstArg of-> SOKNone -> pure Nothing-> SOKOptional -> optionMaybe (try pfa)-> SOKMandatory -> Just <$> pfa-> as <- mapM parseArg kws-> void closeParen-> pure $ SpecialOpK [Name Nothing opName] fa $ catMaybes as-> where-> parseArg (nm,mand) =-> let p = keyword_ nm >> scalarExpr-> in fmap (nm,) <$> if mand-> then Just <$> p-> else optionMaybe (try p)--The actual operators:--EXTRACT( date_part FROM expression )--POSITION( string1 IN string2 )--SUBSTRING(extraction_string FROM starting_position [FOR length]-[COLLATE collation_name])--CONVERT(char_value USING conversion_char_name)--TRANSLATE(char_value USING translation_name)--OVERLAY(string PLACING embedded_string FROM start-[FOR length])--TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]-target_string-[COLLATE collation_name] )--> specialOpKs :: Parser ScalarExpr-> specialOpKs = choice $ map try-> [extract, position, substring, convert, translate, overlay, trim]--> extract :: Parser ScalarExpr-> extract = specialOpK "extract" SOKMandatory [("from", True)]--> position :: Parser ScalarExpr-> position = specialOpK "position" SOKMandatory [("in", True)]--strictly speaking, the substring must have at least one of from and-for, but the parser doens't enforce this--> substring :: Parser ScalarExpr-> substring = specialOpK "substring" SOKMandatory-> [("from", False),("for", False)]--> convert :: Parser ScalarExpr-> convert = specialOpK "convert" SOKMandatory [("using", True)]---> translate :: Parser ScalarExpr-> translate = specialOpK "translate" SOKMandatory [("using", True)]--> overlay :: Parser ScalarExpr-> overlay = specialOpK "overlay" SOKMandatory-> [("placing", True),("from", True),("for", False)]--trim is too different because of the optional char, so a custom parser-the both ' ' is filled in as the default if either parts are missing-in the source--> trim :: Parser ScalarExpr-> trim =-> keyword "trim" >>-> parens (mkTrim-> <$> option "both" sides-> <*> option " " singleQuotesOnlyStringTok-> <*> (keyword_ "from" *> scalarExpr))-> where-> sides = choice ["leading" <$ keyword_ "leading"-> ,"trailing" <$ keyword_ "trailing"-> ,"both" <$ keyword_ "both"]-> mkTrim fa ch fr =-> SpecialOpK [Name Nothing "trim"] Nothing-> $ catMaybes [Just (fa,StringLit "'" "'" ch)-> ,Just ("from", fr)]--=== app, aggregate, window--This parses all these variations:-normal function application with just a csv of scalar exprs-aggregate variations (distinct, order by in parens, filter and where- suffixes)-window apps (fn/agg followed by over)--This code is also a little dense like the typename code because of-left factoring, later they will even have to be partially combined-together.--> app :: Parser ([Name] -> ScalarExpr)-> app =-> openParen *> choice-> [duplicates-> <**> (commaSep1 scalarExpr-> <**> (((option [] orderBy) <* closeParen)-> <**> (optionMaybe afilter <$$$$$> AggregateApp)))-> -- separate cases with no all or distinct which must have at-> -- least one scalar expr-> ,commaSep1 scalarExpr-> <**> choice-> [closeParen *> choice-> [window-> ,withinGroup-> ,(Just <$> afilter) <$$$> aggAppWithoutDupeOrd-> ,pure (flip App)]-> ,orderBy <* closeParen-> <**> (optionMaybe afilter <$$$$> aggAppWithoutDupe)]-> -- no scalarExprs: duplicates and order by not allowed-> ,([] <$ closeParen) <**> option (flip App) (window <|> withinGroup)-> ]-> where-> aggAppWithoutDupeOrd n es f = AggregateApp n SQDefault es [] f-> aggAppWithoutDupe n = AggregateApp n SQDefault--> afilter :: Parser ScalarExpr-> afilter = keyword_ "filter" *> parens (keyword_ "where" *> scalarExpr)--> withinGroup :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)-> withinGroup =-> (keywords_ ["within", "group"] *> parens orderBy) <$$$> AggregateAppGroup--==== window--parse a window call as a suffix of a regular function call-this looks like this:-functionname(args) over ([partition by ids] [order by orderitems])--No support for explicit frames yet.--TODO: add window support for other aggregate variations, needs some-changes to the syntax also--> window :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)-> window =-> keyword_ "over" *> openParen *> option [] partitionBy-> <**> (option [] orderBy-> <**> (((optionMaybe frameClause) <* closeParen) <$$$$$> WindowApp))-> where-> partitionBy = keywords_ ["partition","by"] *> commaSep1 scalarExpr-> frameClause =-> frameRowsRange -- TODO: this 'and' could be an issue-> <**> (choice [(keyword_ "between" *> frameLimit True)-> <**> ((keyword_ "and" *> frameLimit True)-> <$$$> FrameBetween)-> -- maybe this should still use a b expression-> -- for consistency-> ,frameLimit False <**> pure (flip FrameFrom)])-> frameRowsRange = FrameRows <$ keyword_ "rows"-> <|> FrameRange <$ keyword_ "range"-> frameLimit useB =-> choice-> [Current <$ keywords_ ["current", "row"]-> -- todo: create an automatic left factor for stuff like this-> ,keyword_ "unbounded" *>-> choice [UnboundedPreceding <$ keyword_ "preceding"-> ,UnboundedFollowing <$ keyword_ "following"]-> ,(if useB then scalarExprB else scalarExpr)-> <**> (Preceding <$ keyword_ "preceding"-> <|> Following <$ keyword_ "following")-> ]--== suffixes--These are all generic suffixes on any scalar expr--=== in--in: two variations:-a in (expr0, expr1, ...)-a in (queryexpr)--> inSuffix :: Parser (ScalarExpr -> ScalarExpr)-> inSuffix =-> mkIn <$> inty-> <*> parens (choice-> [InQueryExpr <$> queryExpr-> ,InList <$> commaSep1 scalarExpr])-> where-> inty = choice [True <$ keyword_ "in"-> ,False <$ keywords_ ["not","in"]]-> mkIn i v = \e -> In i e v--=== between--between:-expr between expr and expr--There is a complication when parsing between - when parsing the second-expression it is ambiguous when you hit an 'and' whether it is a-binary operator or part of the between. This code follows what-postgres does, which might be standard across SQL implementations,-which is that you can't have a binary and operator in the middle-expression in a between unless it is wrapped in parens. The 'bExpr-parsing' is used to create alternative scalar expression parser which-is identical to the normal one expect it doesn't recognise the binary-and operator. This is the call to scalarExprB.--> betweenSuffix :: Parser (ScalarExpr -> ScalarExpr)-> betweenSuffix =-> makeOp <$> Name Nothing <$> opName-> <*> scalarExprB-> <*> (keyword_ "and" *> scalarExprB)-> where-> opName = choice-> ["between" <$ keyword_ "between"-> ,"not between" <$ try (keywords_ ["not","between"])]-> makeOp n b c = \a -> SpecialOp [n] [a,b,c]--=== quantified comparison--a = any (select * from t)--> quantifiedComparisonSuffix :: Parser (ScalarExpr -> ScalarExpr)-> quantifiedComparisonSuffix = do-> c <- comp-> cq <- compQuan-> q <- parens queryExpr-> pure $ \v -> QuantifiedComparison v [c] cq q-> where-> comp = Name Nothing <$> choice (map symbol-> ["=", "<>", "<=", "<", ">", ">="])-> compQuan = choice-> [CPAny <$ keyword_ "any"-> ,CPSome <$ keyword_ "some"-> ,CPAll <$ keyword_ "all"]--=== match--a match (select a from t)--> matchPredicateSuffix :: Parser (ScalarExpr -> ScalarExpr)-> matchPredicateSuffix = do-> keyword_ "match"-> u <- option False (True <$ keyword_ "unique")-> q <- parens queryExpr-> pure $ \v -> Match v u q--=== array subscript--> arraySuffix :: Parser (ScalarExpr -> ScalarExpr)-> arraySuffix = do-> es <- brackets (commaSep scalarExpr)-> pure $ \v -> Array v es--=== escape--It is going to be really difficult to support an arbitrary character-for the escape now there is a separate lexer ...--TODO: this needs fixing. Escape is only part of other nodes, and not a-separate suffix.--> {-escapeSuffix :: Parser (ScalarExpr -> ScalarExpr)-> escapeSuffix = do-> ctor <- choice-> [Escape <$ keyword_ "escape"-> ,UEscape <$ keyword_ "uescape"]-> c <- escapeChar-> pure $ \v -> ctor v c-> where-> escapeChar :: Parser Char-> escapeChar = (identifierTok [] Nothing <|> symbolTok Nothing) >>= oneOnly-> oneOnly :: String -> Parser Char-> oneOnly c = case c of-> [c'] -> return c'-> _ -> fail "escape char must be single char"-> -}--=== collate--> collateSuffix:: Parser (ScalarExpr -> ScalarExpr)-> collateSuffix = do-> keyword_ "collate"-> i <- names-> pure $ \v -> Collate v i--== odbc syntax--the parser supports three kinds of odbc syntax, two of which are-scalar expressions (the other is a variation on joins)---> odbcExpr :: Parser ScalarExpr-> odbcExpr = between (symbol "{") (symbol "}")-> (odbcTimeLit <|> odbcFunc)-> where-> odbcTimeLit =-> OdbcLiteral <$> choice [OLDate <$ keyword "d"-> ,OLTime <$ keyword "t"-> ,OLTimestamp <$ keyword "ts"]-> <*> singleQuotesOnlyStringTok-> -- todo: this parser is too general, the expr part-> -- should be only a function call (from a whitelist of functions)-> -- or the extract operator-> odbcFunc = OdbcFunc <$> (keyword "fn" *> scalarExpr)--== operators--The 'regular' operators in this parsing and in the abstract syntax are-unary prefix, unary postfix and binary infix operators. The operators-can be symbols (a + b), single keywords (a and b) or multiple keywords-(a is similar to b).--TODO: carefully review the precedences and associativities.--TODO: to fix the parsing completely, I think will need to parse-without precedence and associativity and fix up afterwards, since SQL-syntax is way too messy. It might be possible to avoid this if we-wanted to avoid extensibility and to not be concerned with parse error-messages, but both of these are too important.--> opTable :: Bool -> [[E.Operator [Token] ParseState Identity ScalarExpr]]-> opTable bExpr =-> [-- parse match and quantified comparisons as postfix ops-> -- todo: left factor the quantified comparison with regular-> -- binary comparison, somehow-> [E.Postfix $ try quantifiedComparisonSuffix-> ,E.Postfix matchPredicateSuffix-> ]--> ,[binarySym "." E.AssocLeft]--> ,[postfix' arraySuffix-> ,postfix' collateSuffix]--> ,[prefixSym "+", prefixSym "-"]--> ,[binarySym "^" E.AssocLeft]--> ,[binarySym "*" E.AssocLeft-> ,binarySym "/" E.AssocLeft-> ,binarySym "%" E.AssocLeft]--> ,[binarySym "+" E.AssocLeft-> ,binarySym "-" E.AssocLeft]--> ,[binarySym "||" E.AssocRight-> ,prefixSym "~"-> ,binarySym "&" E.AssocRight-> ,binarySym "|" E.AssocRight]--> ,[binaryKeyword "overlaps" E.AssocNone]--> ,[binaryKeyword "like" E.AssocNone-> -- have to use try with inSuffix because of a conflict-> -- with 'in' in position function, and not between-> -- between also has a try in it to deal with 'not'-> -- ambiguity-> ,E.Postfix $ try inSuffix-> ,E.Postfix betweenSuffix]-> -- todo: figure out where to put the try?-> ++ [binaryKeywords $ makeKeywordTree-> ["not like"-> ,"is similar to"-> ,"is not similar to"]]-> ++ [multisetBinOp]--> ,[binarySym "<" E.AssocNone-> ,binarySym ">" E.AssocNone-> ,binarySym ">=" E.AssocNone-> ,binarySym "<=" E.AssocNone-> ,binarySym "!=" E.AssocRight-> ,binarySym "<>" E.AssocRight-> ,binarySym "=" E.AssocRight]--> ,[postfixKeywords $ makeKeywordTree-> ["is null"-> ,"is not null"-> ,"is true"-> ,"is not true"-> ,"is false"-> ,"is not false"-> ,"is unknown"-> ,"is not unknown"]]-> ++ [binaryKeywords $ makeKeywordTree-> ["is distinct from"-> ,"is not distinct from"]]--> ,[prefixKeyword "not"]--> ,if bExpr then [] else [binaryKeyword "and" E.AssocLeft]--> ,[binaryKeyword "or" E.AssocLeft]--> ]-> where-> binarySym nm assoc = binary (symbol_ nm) nm assoc-> binaryKeyword nm assoc = binary (keyword_ nm) nm assoc-> binaryKeywords p =-> E.Infix (do-> o <- try p-> pure (\a b -> BinOp a [Name Nothing $ unwords o] b))-> E.AssocNone-> postfixKeywords p =-> postfix' $ do-> o <- try p-> pure $ PostfixOp [Name Nothing $ unwords o]-> binary p nm assoc =-> E.Infix (p >> pure (\a b -> BinOp a [Name Nothing nm] b)) assoc-> multisetBinOp = E.Infix (do-> keyword_ "multiset"-> o <- choice [Union <$ keyword_ "union"-> ,Intersect <$ keyword_ "intersect"-> ,Except <$ keyword_ "except"]-> d <- option SQDefault duplicates-> pure (\a b -> MultisetBinOp a o d b))-> E.AssocLeft-> prefixKeyword nm = prefix (keyword_ nm) nm-> prefixSym nm = prefix (symbol_ nm) nm-> prefix p nm = prefix' (p >> pure (PrefixOp [Name Nothing nm]))-> -- hack from here-> -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported-> -- not implemented properly yet-> -- I don't think this will be enough for all cases-> -- at least it works for 'not not a'-> -- ok: "x is not true is not true"-> -- no work: "x is not true is not null"-> prefix' p = E.Prefix . chainl1 p $ pure (.)-> postfix' p = E.Postfix . chainl1 p $ pure (flip (.))--== scalar expression top level--This parses most of the scalar exprs.The order of the parsers and use-of try is carefully done to make everything work. It is a little-fragile and could at least do with some heavy explanation. Update: the-'try's have migrated into the individual parsers, they still need-documenting/fixing.--> scalarExpr :: Parser ScalarExpr-> scalarExpr = E.buildExpressionParser (opTable False) term--> term :: Parser ScalarExpr-> term = choice [simpleLiteral-> ,parameter-> ,positionalArg-> ,star-> ,parensExpr-> ,caseExpr-> ,cast-> ,arrayCtor-> ,multisetCtor-> ,nextValueFor-> ,subquery-> ,intervalLit-> ,specialOpKs-> ,idenExpr-> ,odbcExpr]-> <?> "scalar expression"--expose the b expression for window frame clause range between--> scalarExprB :: Parser ScalarExpr-> scalarExprB = E.buildExpressionParser (opTable True) term--== helper parsers--This is used in interval literals and in interval type names.--> intervalQualifier :: Parser (IntervalTypeField,Maybe IntervalTypeField)-> intervalQualifier =-> (,) <$> intervalField-> <*> optionMaybe (keyword_ "to" *> intervalField)-> where-> intervalField =-> Itf-> <$> datetimeField-> <*> optionMaybe-> (parens ((,) <$> unsignedInteger-> <*> optionMaybe (comma *> unsignedInteger)))--TODO: use datetime field in extract also-use a data type for the datetime field?--> datetimeField :: Parser String-> datetimeField = choice (map keyword ["year","month","day"-> ,"hour","minute","second"])-> <?> "datetime field"--This is used in multiset operations (scalar expr), selects (query expr)-and set operations (query expr).--> duplicates :: Parser SetQuantifier-> duplicates =-> choice [All <$ keyword_ "all"-> ,Distinct <$ keyword "distinct"]-----------------------------------------------------= query expressions--== select lists--> selectItem :: Parser (ScalarExpr,Maybe Name)-> selectItem = (,) <$> scalarExpr <*> optionMaybe als-> where als = optional (keyword_ "as") *> name--> selectList :: Parser [(ScalarExpr,Maybe Name)]-> selectList = commaSep1 selectItem--== from--Here is the rough grammar for joins--tref-(cross | [natural] ([inner] | (left | right | full) [outer])) join-tref-[on expr | using (...)]--TODO: either use explicit 'operator precedence' parsers or build-expression parser for the 'tref operators' such as joins, lateral,-aliases.--> from :: Parser [TableRef]-> from = keyword_ "from" *> commaSep1 tref-> where-> -- TODO: use P (a->) for the join tref suffix-> -- chainl or buildexpressionparser-> tref = nonJoinTref >>= optionSuffix joinTrefSuffix-> nonJoinTref = choice-> [parens $ choice-> [TRQueryExpr <$> queryExpr-> ,TRParens <$> tref]-> ,TRLateral <$> (keyword_ "lateral"-> *> nonJoinTref)-> ,do-> n <- names-> choice [TRFunction n-> <$> parens (commaSep scalarExpr)-> ,pure $ TRSimple n]-> -- todo: I think you can only have outer joins inside the oj,-> -- not sure.-> ,TROdbc <$> (symbol "{" *> keyword_ "oj" *> tref <* symbol "}")-> ] <??> aliasSuffix-> aliasSuffix = fromAlias <$$> TRAlias-> joinTrefSuffix t =-> (TRJoin t <$> option False (True <$ keyword_ "natural")-> <*> joinType-> <*> nonJoinTref-> <*> optionMaybe joinCondition)-> >>= optionSuffix joinTrefSuffix--TODO: factor the join stuff to produce better error messages (and make-it more readable)--> joinType :: Parser JoinType-> joinType = choice-> [JCross <$ keyword_ "cross" <* keyword_ "join"-> ,JInner <$ keyword_ "inner" <* keyword_ "join"-> ,JLeft <$ keyword_ "left"-> <* optional (keyword_ "outer")-> <* keyword_ "join"-> ,JRight <$ keyword_ "right"-> <* optional (keyword_ "outer")-> <* keyword_ "join"-> ,JFull <$ keyword_ "full"-> <* optional (keyword_ "outer")-> <* keyword_ "join"-> ,JInner <$ keyword_ "join"]--> joinCondition :: Parser JoinCondition-> joinCondition = choice-> [keyword_ "on" >> JoinOn <$> scalarExpr-> ,keyword_ "using" >> JoinUsing <$> parens (commaSep1 name)]--> fromAlias :: Parser Alias-> fromAlias = Alias <$> tableAlias <*> columnAliases-> where-> tableAlias = optional (keyword_ "as") *> name-> columnAliases = optionMaybe $ parens $ commaSep1 name--== simple other parts--Parsers for where, group by, having, order by and limit, which are-pretty trivial.--> whereClause :: Parser ScalarExpr-> whereClause = keyword_ "where" *> scalarExpr--> groupByClause :: Parser [GroupingExpr]-> groupByClause = keywords_ ["group","by"] *> commaSep1 groupingExpression-> where-> groupingExpression = choice-> [keyword_ "cube" >>-> Cube <$> parens (commaSep groupingExpression)-> ,keyword_ "rollup" >>-> Rollup <$> parens (commaSep groupingExpression)-> ,GroupingParens <$> parens (commaSep groupingExpression)-> ,keywords_ ["grouping", "sets"] >>-> GroupingSets <$> parens (commaSep groupingExpression)-> ,SimpleGroup <$> scalarExpr-> ]--> having :: Parser ScalarExpr-> having = keyword_ "having" *> scalarExpr--> orderBy :: Parser [SortSpec]-> orderBy = keywords_ ["order","by"] *> commaSep1 ob-> where-> ob = SortSpec-> <$> scalarExpr-> <*> option DirDefault (choice [Asc <$ keyword_ "asc"-> ,Desc <$ keyword_ "desc"])-> <*> option NullsOrderDefault-> -- todo: left factor better-> (keyword_ "nulls" >>-> choice [NullsFirst <$ keyword "first"-> ,NullsLast <$ keyword "last"])--allows offset and fetch in either order-+ postgresql offset without row(s) and limit instead of fetch also--> offsetFetch :: Parser (Maybe ScalarExpr, Maybe ScalarExpr)-> offsetFetch = permute ((,) <$?> (Nothing, Just <$> offset)-> <|?> (Nothing, Just <$> fetch))--> offset :: Parser ScalarExpr-> offset = keyword_ "offset" *> scalarExpr-> <* option () (choice [keyword_ "rows"-> ,keyword_ "row"])--> fetch :: Parser ScalarExpr-> fetch = fetchFirst <|> limit-> where-> fetchFirst = guardDialect diFetchFirst-> *> fs *> scalarExpr <* ro-> fs = makeKeywordTree ["fetch first", "fetch next"]-> ro = makeKeywordTree ["rows only", "row only"]-> -- todo: not in ansi sql dialect-> limit = guardDialect diLimit *>-> keyword_ "limit" *> scalarExpr--== common table expressions--> with :: Parser QueryExpr-> with = keyword_ "with" >>-> With <$> option False (True <$ keyword_ "recursive")-> <*> commaSep1 withQuery <*> queryExpr-> where-> withQuery = (,) <$> (withAlias <* keyword_ "as")-> <*> parens queryExpr-> withAlias = Alias <$> name <*> columnAliases-> columnAliases = optionMaybe $ parens $ commaSep1 name---== query expression--This parser parses any query expression variant: normal select, cte,-and union, etc..--> queryExpr :: Parser QueryExpr-> queryExpr = choice-> [with-> ,chainr1 (choice [values,table, select]) setOp]-> where-> select = keyword_ "select" >>-> mkSelect-> <$> option SQDefault duplicates-> <*> selectList-> <*> optionMaybe tableExpression-> mkSelect d sl Nothing =-> makeSelect{qeSetQuantifier = d, qeSelectList = sl}-> mkSelect d sl (Just (TableExpression f w g h od ofs fe)) =-> Select d sl f w g h od ofs fe-> values = keyword_ "values"-> >> Values <$> commaSep (parens (commaSep scalarExpr))-> table = keyword_ "table" >> Table <$> names--local data type to help with parsing the bit after the select list,-called 'table expression' in the ansi sql grammar. Maybe this should-be in the public syntax?--> data TableExpression-> = TableExpression-> {_teFrom :: [TableRef]-> ,_teWhere :: Maybe ScalarExpr-> ,_teGroupBy :: [GroupingExpr]-> ,_teHaving :: Maybe ScalarExpr-> ,_teOrderBy :: [SortSpec]-> ,_teOffset :: Maybe ScalarExpr-> ,_teFetchFirst :: Maybe ScalarExpr}--> tableExpression :: Parser TableExpression-> tableExpression = mkTe <$> from-> <*> optionMaybe whereClause-> <*> option [] groupByClause-> <*> optionMaybe having-> <*> option [] orderBy-> <*> offsetFetch-> where-> mkTe f w g h od (ofs,fe) =-> TableExpression f w g h od ofs fe--> setOp :: Parser (QueryExpr -> QueryExpr -> QueryExpr)-> setOp = cq-> <$> setOpK-> <*> option SQDefault duplicates-> <*> corr-> where-> cq o d c q0 q1 = QueryExprSetOp q0 o d c q1-> setOpK = choice [Union <$ keyword_ "union"-> ,Intersect <$ keyword_ "intersect"-> ,Except <$ keyword_ "except"]-> <?> "set operator"-> corr = option Respectively (Corresponding <$ keyword_ "corresponding")---wrapper for query expr which ignores optional trailing semicolon.--TODO: change style--> topLevelQueryExpr :: Parser QueryExpr-> topLevelQueryExpr = queryExpr <??> (id <$ semi)--> topLevelStatement :: Parser Statement-> topLevelStatement = statement <??> (id <$ semi)-----------------------------= Statements--> statement :: Parser Statement-> statement = choice-> [keyword_ "create" *> choice [createSchema-> ,createTable-> ,createView-> ,createDomain-> ,createSequence-> ,createRole-> ,createAssertion]-> ,keyword_ "alter" *> choice [alterTable-> ,alterDomain-> ,alterSequence]-> ,keyword_ "drop" *> choice [dropSchema-> ,dropTable-> ,dropView-> ,dropDomain-> ,dropSequence-> ,dropRole-> ,dropAssertion]-> ,delete-> ,truncateSt-> ,insert-> ,update-> ,startTransaction-> ,savepoint-> ,releaseSavepoint-> ,commit-> ,rollback-> ,grant-> ,revoke-> ,SelectStatement <$> queryExpr-> ]--> createSchema :: Parser Statement-> createSchema = keyword_ "schema" >>-> CreateSchema <$> names--> createTable :: Parser Statement-> createTable = keyword_ "table" >>-> CreateTable-> <$> names-> -- todo: is this order mandatory or is it a perm?-> <*> parens (commaSep1 (uncurry TableConstraintDef <$> tableConstraintDef-> <|> TableColumnDef <$> columnDef))--> columnDef :: Parser ColumnDef-> columnDef = ColumnDef <$> name <*> typeName-> <*> optionMaybe defaultClause-> <*> option [] (many1 colConstraintDef)-> where-> defaultClause = choice [-> keyword_ "default" >>-> DefaultClause <$> scalarExpr-> -- todo: left factor-> ,try (keywords_ ["generated","always","as"] >>-> GenerationClause <$> parens scalarExpr)-> ,keyword_ "generated" >>-> IdentityColumnSpec-> <$> (GeneratedAlways <$ keyword_ "always"-> <|> GeneratedByDefault <$ keywords_ ["by", "default"])-> <*> (keywords_ ["as", "identity"] *>-> option [] (parens sequenceGeneratorOptions))-> ]--> tableConstraintDef :: Parser (Maybe [Name], TableConstraint)-> tableConstraintDef =-> (,)-> <$> (optionMaybe (keyword_ "constraint" *> names))-> <*> (unique <|> primaryKey <|> check <|> references)-> where-> unique = keyword_ "unique" >>-> TableUniqueConstraint <$> parens (commaSep1 name)-> primaryKey = keywords_ ["primary", "key"] >>-> TablePrimaryKeyConstraint <$> parens (commaSep1 name)-> check = keyword_ "check" >> TableCheckConstraint <$> parens scalarExpr-> references = keywords_ ["foreign", "key"] >>-> (\cs ft ftcs m (u,d) -> TableReferencesConstraint cs ft ftcs m u d)-> <$> parens (commaSep1 name)-> <*> (keyword_ "references" *> names)-> <*> optionMaybe (parens $ commaSep1 name)-> <*> refMatch-> <*> refActions--> refMatch :: Parser ReferenceMatch-> refMatch = option DefaultReferenceMatch-> (keyword_ "match" *>-> choice [MatchFull <$ keyword_ "full"-> ,MatchPartial <$ keyword_ "partial"-> ,MatchSimple <$ keyword_ "simple"])-> refActions :: Parser (ReferentialAction,ReferentialAction)-> refActions = permute ((,) <$?> (DefaultReferentialAction, onUpdate)-> <|?> (DefaultReferentialAction, onDelete))-> where-> -- todo: left factor?-> onUpdate = try (keywords_ ["on", "update"]) *> referentialAction-> onDelete = try (keywords_ ["on", "delete"]) *> referentialAction-> referentialAction = choice [-> RefCascade <$ keyword_ "cascade"-> -- todo: left factor?-> ,RefSetNull <$ try (keywords_ ["set", "null"])-> ,RefSetDefault <$ try (keywords_ ["set", "default"])-> ,RefRestrict <$ keyword_ "restrict"-> ,RefNoAction <$ keywords_ ["no", "action"]]--> colConstraintDef :: Parser ColConstraintDef-> colConstraintDef =-> ColConstraintDef-> <$> (optionMaybe (keyword_ "constraint" *> names))-> <*> (notNull <|> unique <|> primaryKey <|> check <|> references)-> where-> notNull = ColNotNullConstraint <$ keywords_ ["not", "null"]-> unique = ColUniqueConstraint <$ keyword_ "unique"-> primaryKey = ColPrimaryKeyConstraint <$ keywords_ ["primary", "key"]-> check = keyword_ "check" >> ColCheckConstraint <$> parens scalarExpr-> references = keyword_ "references" >>-> (\t c m (ou,od) -> ColReferencesConstraint t c m ou od)-> <$> names-> <*> optionMaybe (parens name)-> <*> refMatch-> <*> refActions--slightly hacky parser for signed integers--> signedInteger :: Parser Integer-> signedInteger =-> (*) <$> option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")-> <*> unsignedInteger--> sequenceGeneratorOptions :: Parser [SequenceGeneratorOption]-> sequenceGeneratorOptions =-> -- todo: could try to combine exclusive options-> -- such as cycle and nocycle-> -- sort out options which are sometimes not allowed-> -- as datatype, and restart with-> permute ((\a b c d e f g h j k -> catMaybes [a,b,c,d,e,f,g,h,j,k])-> <$?> nj startWith-> <|?> nj dataType-> <|?> nj restart-> <|?> nj incrementBy-> <|?> nj maxValue-> <|?> nj noMaxValue-> <|?> nj minValue-> <|?> nj noMinValue-> <|?> nj scycle-> <|?> nj noCycle-> )-> where-> nj p = (Nothing,Just <$> p)-> startWith = keywords_ ["start", "with"] >>-> SGOStartWith <$> signedInteger-> dataType = keyword_ "as" >>-> SGODataType <$> typeName-> restart = keyword_ "restart" >>-> SGORestart <$> optionMaybe (keyword_ "with" *> signedInteger)-> incrementBy = keywords_ ["increment", "by"] >>-> SGOIncrementBy <$> signedInteger-> maxValue = keyword_ "maxvalue" >>-> SGOMaxValue <$> signedInteger-> noMaxValue = SGONoMaxValue <$ try (keywords_ ["no","maxvalue"])-> minValue = keyword_ "minvalue" >>-> SGOMinValue <$> signedInteger-> noMinValue = SGONoMinValue <$ try (keywords_ ["no","minvalue"])-> scycle = SGOCycle <$ keyword_ "cycle"-> noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"])---> alterTable :: Parser Statement-> alterTable = keyword_ "table" >>-> -- the choices have been ordered so that it works-> AlterTable <$> names <*> choice [addConstraint-> ,dropConstraint-> ,addColumnDef-> ,alterColumn-> ,dropColumn-> ]-> where-> addColumnDef = try (keyword_ "add"-> *> optional (keyword_ "column")) >>-> AddColumnDef <$> columnDef-> alterColumn = keyword_ "alter" >> optional (keyword_ "column") >>-> name <**> choice [setDefault-> ,dropDefault-> ,setNotNull-> ,dropNotNull-> ,setDataType]-> setDefault :: Parser (Name -> AlterTableAction)-> -- todo: left factor-> setDefault = try (keywords_ ["set","default"]) >>-> scalarExpr <$$> AlterColumnSetDefault-> dropDefault = AlterColumnDropDefault <$ try (keywords_ ["drop","default"])-> setNotNull = AlterColumnSetNotNull <$ try (keywords_ ["set","not","null"])-> dropNotNull = AlterColumnDropNotNull <$ try (keywords_ ["drop","not","null"])-> setDataType = try (keywords_ ["set","data","type"]) >>-> typeName <$$> AlterColumnSetDataType-> dropColumn = try (keyword_ "drop" *> optional (keyword_ "column")) >>-> DropColumn <$> name <*> dropBehaviour-> -- todo: left factor, this try is especially bad-> addConstraint = try (keyword_ "add" >>-> uncurry AddTableConstraintDef <$> tableConstraintDef)-> dropConstraint = try (keywords_ ["drop","constraint"]) >>-> DropTableConstraintDef <$> names <*> dropBehaviour---> dropSchema :: Parser Statement-> dropSchema = keyword_ "schema" >>-> DropSchema <$> names <*> dropBehaviour--> dropTable :: Parser Statement-> dropTable = keyword_ "table" >>-> DropTable <$> names <*> dropBehaviour--> createView :: Parser Statement-> createView =-> CreateView-> <$> (option False (True <$ keyword_ "recursive") <* keyword_ "view")-> <*> names-> <*> optionMaybe (parens (commaSep1 name))-> <*> (keyword_ "as" *> queryExpr)-> <*> optionMaybe (choice [-> -- todo: left factor-> DefaultCheckOption <$ try (keywords_ ["with", "check", "option"])-> ,CascadedCheckOption <$ try (keywords_ ["with", "cascaded", "check", "option"])-> ,LocalCheckOption <$ try (keywords_ ["with", "local", "check", "option"])-> ])--> dropView :: Parser Statement-> dropView = keyword_ "view" >>-> DropView <$> names <*> dropBehaviour--> createDomain :: Parser Statement-> createDomain = keyword_ "domain" >>-> CreateDomain-> <$> names-> <*> (optional (keyword_ "as") *> typeName)-> <*> optionMaybe (keyword_ "default" *> scalarExpr)-> <*> many con-> where-> con = (,) <$> optionMaybe (keyword_ "constraint" *> names)-> <*> (keyword_ "check" *> parens scalarExpr)--> alterDomain :: Parser Statement-> alterDomain = keyword_ "domain" >>-> AlterDomain-> <$> names-> <*> (setDefault <|> constraint-> <|> (keyword_ "drop" *> (dropDefault <|> dropConstraint)))-> where-> setDefault = keywords_ ["set", "default"] >> ADSetDefault <$> scalarExpr-> constraint = keyword_ "add" >>-> ADAddConstraint-> <$> optionMaybe (keyword_ "constraint" *> names)-> <*> (keyword_ "check" *> parens scalarExpr)-> dropDefault = ADDropDefault <$ keyword_ "default"-> dropConstraint = keyword_ "constraint" >> ADDropConstraint <$> names--> dropDomain :: Parser Statement-> dropDomain = keyword_ "domain" >>-> DropDomain <$> names <*> dropBehaviour--> createSequence :: Parser Statement-> createSequence = keyword_ "sequence" >>-> CreateSequence-> <$> names-> <*> sequenceGeneratorOptions--> alterSequence :: Parser Statement-> alterSequence = keyword_ "sequence" >>-> AlterSequence-> <$> names-> <*> sequenceGeneratorOptions--> dropSequence :: Parser Statement-> dropSequence = keyword_ "sequence" >>-> DropSequence <$> names <*> dropBehaviour--> createAssertion :: Parser Statement-> createAssertion = keyword_ "assertion" >>-> CreateAssertion-> <$> names-> <*> (keyword_ "check" *> parens scalarExpr)---> dropAssertion :: Parser Statement-> dropAssertion = keyword_ "assertion" >>-> DropAssertion <$> names <*> dropBehaviour---------------------= dml--> delete :: Parser Statement-> delete = keywords_ ["delete","from"] >>-> Delete-> <$> names-> <*> optionMaybe (optional (keyword_ "as") *> name)-> <*> optionMaybe (keyword_ "where" *> scalarExpr)--> truncateSt :: Parser Statement-> truncateSt = keywords_ ["truncate", "table"] >>-> Truncate-> <$> names-> <*> option DefaultIdentityRestart-> (ContinueIdentity <$ keywords_ ["continue","identity"]-> <|> RestartIdentity <$ keywords_ ["restart","identity"])--> insert :: Parser Statement-> insert = keywords_ ["insert", "into"] >>-> Insert-> <$> names-> <*> optionMaybe (parens $ commaSep1 name)-> <*> (DefaultInsertValues <$ keywords_ ["default", "values"]-> <|> InsertQuery <$> queryExpr)--> update :: Parser Statement-> update = keywords_ ["update"] >>-> Update-> <$> names-> <*> optionMaybe (optional (keyword_ "as") *> name)-> <*> (keyword_ "set" *> commaSep1 setClause)-> <*> optionMaybe (keyword_ "where" *> scalarExpr)-> where-> setClause = multipleSet <|> singleSet-> multipleSet = SetMultiple-> <$> parens (commaSep1 names)-> <*> (symbol "=" *> parens (commaSep1 scalarExpr))-> singleSet = Set-> <$> names-> <*> (symbol "=" *> scalarExpr)--> dropBehaviour :: Parser DropBehaviour-> dropBehaviour =-> option DefaultDropBehaviour-> (Restrict <$ keyword_ "restrict"-> <|> Cascade <$ keyword_ "cascade")---------------------------------= transaction management--> startTransaction :: Parser Statement-> startTransaction = StartTransaction <$ keywords_ ["start","transaction"]--> savepoint :: Parser Statement-> savepoint = keyword_ "savepoint" >>-> Savepoint <$> name--> releaseSavepoint :: Parser Statement-> releaseSavepoint = keywords_ ["release","savepoint"] >>-> ReleaseSavepoint <$> name--> commit :: Parser Statement-> commit = Commit <$ keyword_ "commit" <* optional (keyword_ "work")--> rollback :: Parser Statement-> rollback = keyword_ "rollback" >> optional (keyword_ "work") >>-> Rollback <$> optionMaybe (keywords_ ["to", "savepoint"] *> name)-----------------------------------= Access control--TODO: fix try at the 'on'--> grant :: Parser Statement-> grant = keyword_ "grant" >> (try priv <|> role)-> where-> priv = GrantPrivilege-> <$> commaSep privilegeAction-> <*> (keyword_ "on" *> privilegeObject)-> <*> (keyword_ "to" *> commaSep name)-> <*> option WithoutGrantOption-> (WithGrantOption <$ keywords_ ["with","grant","option"])-> role = GrantRole-> <$> commaSep name-> <*> (keyword_ "to" *> commaSep name)-> <*> option WithoutAdminOption-> (WithAdminOption <$ keywords_ ["with","admin","option"])--> createRole :: Parser Statement-> createRole = keyword_ "role" >>-> CreateRole <$> name--> dropRole :: Parser Statement-> dropRole = keyword_ "role" >>-> DropRole <$> name--TODO: fix try at the 'on'--> revoke :: Parser Statement-> revoke = keyword_ "revoke" >> (try priv <|> role)-> where-> priv = RevokePrivilege-> <$> option NoGrantOptionFor-> (GrantOptionFor <$ keywords_ ["grant","option","for"])-> <*> commaSep privilegeAction-> <*> (keyword_ "on" *> privilegeObject)-> <*> (keyword_ "from" *> commaSep name)-> <*> dropBehaviour-> role = RevokeRole-> <$> option NoAdminOptionFor-> (AdminOptionFor <$ keywords_ ["admin","option", "for"])-> <*> commaSep name-> <*> (keyword_ "from" *> commaSep name)-> <*> dropBehaviour--> privilegeAction :: Parser PrivilegeAction-> privilegeAction = choice-> [PrivAll <$ keywords_ ["all","privileges"]-> ,keyword_ "select" >>-> PrivSelect <$> option [] (parens $ commaSep name)-> ,PrivDelete <$ keyword_ "delete"-> ,PrivUsage <$ keyword_ "usage"-> ,PrivTrigger <$ keyword_ "trigger"-> ,PrivExecute <$ keyword_ "execute"-> ,keyword_ "insert" >>-> PrivInsert <$> option [] (parens $ commaSep name)-> ,keyword_ "update" >>-> PrivUpdate <$> option [] (parens $ commaSep name)-> ,keyword_ "references" >>-> PrivReferences <$> option [] (parens $ commaSep name)-> ]--> privilegeObject :: Parser PrivilegeObject-> privilegeObject = choice-> [keyword_ "domain" >> PrivDomain <$> names-> ,keyword_ "type" >> PrivType <$> names-> ,keyword_ "sequence" >> PrivSequence <$> names-> ,keywords_ ["specific","function"] >> PrivFunction <$> names-> ,optional (keyword_ "table") >> PrivTable <$> names-> ]---------------------------------wrapper to parse a series of statements. They must be separated by-semicolon, but for the last statement, the trailing semicolon is-optional.--TODO: change style--> statements :: Parser [Statement]-> statements = (:[]) <$> statement-> >>= optionSuffix ((semi *>) . pure)-> >>= optionSuffix (\p -> (p++) <$> statements)--------------------------------------------------= multi keyword helper--This helper is to help parsing multiple options of multiple keywords-with similar prefixes, e.g. parsing 'is null' and 'is not null'.--use to left factor/ improve:-typed literal and general identifiers-not like, not in, not between operators-help with factoring keyword functions and other app-likes-the join keyword sequences-fetch first/next-row/rows only--There is probably a simpler way of doing this but I am a bit-thick.--> makeKeywordTree :: [String] -> Parser [String]-> makeKeywordTree sets =-> parseTrees (sort $ map words sets)-> where-> parseTrees :: [[String]] -> Parser [String]-> parseTrees ws = do-> let gs :: [[[String]]]-> gs = groupBy ((==) `on` safeHead) ws-> choice $ map parseGroup gs-> parseGroup :: [[String]] -> Parser [String]-> parseGroup l@((k:_):_) = do-> keyword_ k-> let tls = catMaybes $ map safeTail l-> pr = (k:) <$> parseTrees tls-> if (or $ map null tls)-> then pr <|> pure [k]-> else pr-> parseGroup _ = guard False >> error "impossible"-> safeHead (x:_) = Just x-> safeHead [] = Nothing-> safeTail (_:x) = Just x-> safeTail [] = Nothing----------------------------------------------------= lexing--TODO: push checks into here:-keyword blacklists-unsigned integer match-symbol matching-keyword matching--> stringTok :: Parser (String,String,String)-> stringTok = mytoken (\tok ->-> case tok of-> L.SqlString s e t -> Just (s,e,t)-> _ -> Nothing)--> singleQuotesOnlyStringTok :: Parser String-> singleQuotesOnlyStringTok = mytoken (\tok ->-> case tok of-> L.SqlString "'" "'" t -> Just t-> _ -> Nothing)--This is to support SQL strings where you can write-'part of a string' ' another part'-and it will parse as a single string--It is only allowed when all the strings are quoted with ' atm.--> stringTokExtend :: Parser (String,String,String)-> stringTokExtend = do-> (s,e,x) <- stringTok-> choice [-> do-> guard (s == "'" && e == "'")-> (s',e',y) <- stringTokExtend-> guard (s' == "'" && e' == "'")-> return $ (s,e,x ++ y)-> ,return (s,e,x)-> ]--> hostParamTok :: Parser String-> hostParamTok = mytoken (\tok ->-> case tok of-> L.PrefixedVariable c p -> Just (c:p)-> _ -> Nothing)--> positionalArgTok :: Parser Int-> positionalArgTok = mytoken (\tok ->-> case tok of-> L.PositionalArg p -> Just p-> _ -> Nothing)---> sqlNumberTok :: Bool -> Parser String-> sqlNumberTok intOnly = mytoken (\tok ->-> case tok of-> L.SqlNumber p | not intOnly || all isDigit p -> Just p-> _ -> Nothing)---> symbolTok :: Maybe String -> Parser String-> symbolTok sym = mytoken (\tok ->-> case (sym,tok) of-> (Nothing, L.Symbol p) -> Just p-> (Just s, L.Symbol p) | s == p -> Just p-> _ -> Nothing)--> identifierTok :: [String] -> Parser (Maybe (String,String), String)-> identifierTok blackList = mytoken (\tok ->-> case tok of-> L.Identifier q@(Just {}) p -> Just (q,p)-> L.Identifier q p | map toLower p `notElem` blackList -> Just (q,p)-> _ -> Nothing)--> unquotedIdentifierTok :: [String] -> Maybe String -> Parser String-> unquotedIdentifierTok blackList kw = mytoken (\tok ->-> case (kw,tok) of-> (Nothing, L.Identifier Nothing p) | map toLower p `notElem` blackList -> Just p-> (Just k, L.Identifier Nothing p) | k == map toLower p -> Just p-> _ -> Nothing)--> mytoken :: (L.Token -> Maybe a) -> Parser a-> mytoken test = token showToken posToken testToken-> where-> showToken (_,tok) = show tok-> posToken ((a,b,c),_) = newPos a b c-> testToken (_,tok) = test tok--> unsignedInteger :: Parser Integer-> unsignedInteger = read <$> sqlNumberTok True <?> "natural number"--todo: work out the symbol parsing better--> symbol :: String -> Parser String-> symbol s = symbolTok (Just s) <?> s--> singleCharSymbol :: Char -> Parser Char-> singleCharSymbol c = c <$ symbol [c]--> questionMark :: Parser Char-> questionMark = singleCharSymbol '?' <?> "question mark"--> openParen :: Parser Char-> openParen = singleCharSymbol '('--> closeParen :: Parser Char-> closeParen = singleCharSymbol ')'--> openBracket :: Parser Char-> openBracket = singleCharSymbol '['--> closeBracket :: Parser Char-> closeBracket = singleCharSymbol ']'---> comma :: Parser Char-> comma = singleCharSymbol ','--> semi :: Parser Char-> semi = singleCharSymbol ';'--= helper functions--> keyword :: String -> Parser String-> keyword k = unquotedIdentifierTok [] (Just k) <?> k--helper function to improve error messages--> keywords_ :: [String] -> Parser ()-> keywords_ ks = mapM_ keyword_ ks <?> intercalate " " ks---> parens :: Parser a -> Parser a-> parens = between openParen closeParen--> brackets :: Parser a -> Parser a-> brackets = between openBracket closeBracket--> commaSep :: Parser a -> Parser [a]-> commaSep = (`sepBy` comma)--> keyword_ :: String -> Parser ()-> keyword_ = void . keyword--> symbol_ :: String -> Parser ()-> symbol_ = void . symbol--> commaSep1 :: Parser a -> Parser [a]-> commaSep1 = (`sepBy1` comma)--> blacklist :: Dialect -> [String]-> blacklist d = diKeywords d--These blacklisted names are mostly needed when we parse something with-an optional alias, e.g. select a a from t. If we write select a from-t, we have to make sure the from isn't parsed as an alias. I'm not-sure what other places strictly need the blacklist, and in theory it-could be tuned differently for each place the identifierString/-identifier parsers are used to only blacklist the bare-minimum. Something like this might be needed for dialect support, even-if it is pretty silly to use a keyword as an unquoted identifier when-there is a quoting syntax as well.--The standard has a weird mix of reserved keywords and unreserved-keywords (I'm not sure what exactly being an unreserved keyword-means).--The current approach tries to have everything which is a keyword only-in the keyword list - so it can only be used in some other context if-quoted. If something is a 'ansi keyword', but appears only as an-identifier or function name for instance in the syntax (or something-that looks identical to this), then it isn't treated as a keyword at-all. When there is some overlap (e.g. 'set'), then there is either-special case parsing code to handle this (in the case of set), or it-is not treated as a keyword (not perfect, but if it more or less-works, ok for now).--An exception to this is the standard type names are considered as-keywords at the moment, with a special case in the type parser to-make this work. Maybe this isn't necessary or is a bad idea.--It is possible to have a problem if you remove something which is a-keyword from this list, and still want to parse statements using it-as a keyword - for instance, removing things like 'from' or 'as',-will likely mean many things don't parse anymore.-----------------Used to make the dialect available during parsing so different parsers-can be used for different dialects. Not sure if this is the best way-to do it, but it's convenient--> type ParseState = Dialect--> type Token = ((String,Int,Int),L.Token)--> type Parser = GenParser Token ParseState--> guardDialect :: (Dialect -> Bool) -> Parser ()-> guardDialect f = do-> d <- getState-> guard (f d)--The dialect stuff could also be used for custom options: e.g. to only-parse dml for instance.
+ Language/SQL/SimpleSQL/Pretty.hs view
@@ -0,0 +1,894 @@++-- | These is the pretty printing functions, which produce SQL+-- source from ASTs. The code attempts to format the output in a+-- readable way.+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+module Language.SQL.SimpleSQL.Pretty+ (prettyQueryExpr+ ,prettyScalarExpr+ ,prettyStatement+ ,prettyStatements+ ) where++{-+TODO: there should be more comments in this file, especially the bits+which have been changed to try to improve the layout of the output.+-}++import Prettyprinter (Doc+ ,nest+ ,punctuate+ ,comma+ ,squotes+ ,vsep+ ,layoutPretty+ ,defaultLayoutOptions+ ,brackets+ ,align+ ,hcat+ ,line+ )+import qualified Prettyprinter as P+import Prettyprinter.Internal.Type (Doc(Empty))++import Prettyprinter.Render.Text (renderStrict)++import Data.Maybe (maybeToList, catMaybes)++import qualified Data.Text as T+import Data.Text (Text)++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.Dialect+++-- | Convert a query expr ast to Text.+prettyQueryExpr :: Dialect -> QueryExpr -> Text+prettyQueryExpr d = render . queryExpr d++-- | Convert a value expr ast to Text.+prettyScalarExpr :: Dialect -> ScalarExpr -> Text+prettyScalarExpr d = render . scalarExpr d++-- | A terminating semicolon.+terminator :: Doc a+terminator = pretty ";" <> line++-- | Convert a statement ast to Text.+prettyStatement :: Dialect -> Statement -> Text+prettyStatement _ EmptyStatement = render terminator+prettyStatement d s = render (statement d s)++-- | Convert a list of statements to Text. A semicolon+-- is inserted after each statement.+prettyStatements :: Dialect -> [Statement] -> Text+prettyStatements d = render . vsep . map prettyStatementWithSemicolon+ where+ prettyStatementWithSemicolon :: Statement -> Doc a+ prettyStatementWithSemicolon s = statement d s <> terminator++render :: Doc a -> Text+render = renderStrict . layoutPretty defaultLayoutOptions++-- = scalar expressions++scalarExpr :: Dialect -> ScalarExpr -> Doc a+scalarExpr _ (StringLit s e t) = pretty s <> pretty t <> pretty e++scalarExpr _ (NumLit s) = pretty s+scalarExpr _ (IntervalLit s v f t) =+ pretty "interval"+ <+> me (\x -> pretty $ case x of+ Plus -> "+"+ Minus -> "-") s+ <+> squotes (pretty v)+ <+> intervalTypeField f+ <+> me (\x -> pretty "to" <+> intervalTypeField x) t+scalarExpr _ (Iden i) = names i+scalarExpr _ Star = pretty "*"+scalarExpr _ Parameter = pretty "?"+scalarExpr _ (PositionalArg n) = pretty $ T.cons '$' $ showText n+scalarExpr _ (HostParameter p i) =+ pretty p+ <+> me (\i' -> pretty "indicator" <+> pretty i') i++scalarExpr d (App f es) = names f <> parens (commaSep (map (scalarExpr d) es))++scalarExpr dia (AggregateApp f d es od fil) =+ (names f+ <> parens ((case d of+ Distinct -> pretty "distinct"+ All -> pretty "all"+ SQDefault -> mempty)+ <+> commaSep (map (scalarExpr dia) es)+ <+> orderBy dia od))+ <+> me (\x -> pretty "filter"+ <+> parens (pretty "where" <+> scalarExpr dia x)) fil++scalarExpr d (AggregateAppGroup f es od) =+ names f+ <> parens (commaSep (map (scalarExpr d) es))+ <+> if null od+ then mempty+ else pretty "within group" <+> parens (orderBy d od)++scalarExpr d (WindowApp f es pb od fr) =+ names f <> parens (commaSep $ map (scalarExpr d) es)+ <+> pretty "over"+ <+> parens ((case pb of+ [] -> mempty+ _ -> pretty "partition by" <+> align+ (commaSep $ map (scalarExpr d) pb))+ <+> orderBy d od+ <+> me frd fr)+ where+ frd (FrameFrom rs fp) = rsd rs <+> fpd fp+ frd (FrameBetween rs fps fpe) =+ rsd rs <+> pretty "between" <+> fpd fps+ <+> pretty "and" <+> fpd fpe+ rsd rs = case rs of+ FrameRows -> pretty "rows"+ FrameRange -> pretty "range"+ fpd UnboundedPreceding = pretty "unbounded preceding"+ fpd UnboundedFollowing = pretty "unbounded following"+ fpd Current = pretty "current row"+ fpd (Preceding e) = scalarExpr d e <+> pretty "preceding"+ fpd (Following e) = scalarExpr d e <+> pretty "following"++scalarExpr dia (SpecialOp nm [a,b,c])+ | nm `elem` [[Name Nothing "between"]+ ,[Name Nothing "not between"]] =+ sep [scalarExpr dia a+ ,names nm <+> nest (T.length (unnames nm) - 3) (sep+ [scalarExpr dia b+ ,pretty "and" <+> scalarExpr dia c])]++scalarExpr d (SpecialOp [Name Nothing "rowctor"] as) =+ parens $ commaSep $ map (scalarExpr d) as++scalarExpr d (SpecialOp nm es) =+ names nm <+> parens (commaSep $ map (scalarExpr d) es)++scalarExpr d (SpecialOpK nm fs as) =+ names nm <> parens (sep $ catMaybes+ (fmap (scalarExpr d) fs+ : map (\(n,e) -> Just (pretty n <+> scalarExpr d e)) as))++scalarExpr d (PrefixOp f e) = names f <+> scalarExpr d e+scalarExpr d (PostfixOp f e) = scalarExpr d e <+> names f+scalarExpr d e@(BinOp _ op _) | op `elem` [[Name Nothing "and"]+ ,[Name Nothing "or"]] =+ -- special case for and, or, get all the ands so we can vsep them+ -- nicely+ case ands e of+ (e':es) -> vsep (scalarExpr d e'+ : map ((names op <+>) . scalarExpr d) es)+ [] -> mempty -- shouldn't be possible+ where+ ands (BinOp a op' b) | op == op' = ands a <> ands b+ ands x = [x]+-- special case for . we don't use whitespace+scalarExpr d (BinOp e0 [Name Nothing "."] e1) =+ scalarExpr d e0 <> pretty "." <> scalarExpr d e1+scalarExpr d (BinOp e0 f e1) =+ scalarExpr d e0 <+> names f <+> scalarExpr d e1++scalarExpr dia (Case t ws els) =+ sep $ [pretty "case" <+> me (scalarExpr dia) t]+ <> map w ws+ <> maybeToList (fmap e els)+ <> [pretty "end"]+ where+ w (t0,t1) =+ pretty "when" <+> align (sep [commaSep $ map (scalarExpr dia) t0+ ,pretty "then" <+> align (scalarExpr dia t1)])+ e el = pretty "else" <+> align (scalarExpr dia el)+scalarExpr d (Parens e) =+ parens (scalarExpr d e)+scalarExpr d (Cast e tn) =+ pretty "cast" <> parens (sep [scalarExpr d e+ ,pretty "as"+ ,typeName tn])++scalarExpr _ (TypedLit tn s) =+ typeName tn <+> squotes (pretty s)++scalarExpr d (SubQueryExpr ty qe) =+ (case ty of+ SqSq -> mempty+ SqExists -> pretty "exists"+ SqUnique -> pretty "unique"+ ) <+> parens (queryExpr d qe)++scalarExpr d (QuantifiedComparison v c cp sq) =+ scalarExpr d v+ <+> names c+ <+> pretty (case cp of+ CPAny -> "any"+ CPSome -> "some"+ CPAll -> "all")+ <+> parens (queryExpr d sq)++scalarExpr d (Match v u sq) =+ scalarExpr d v+ <+> pretty "match"+ <+> (if u then pretty "unique" else mempty)+ <+> parens (queryExpr d sq)++scalarExpr d (In b se x) =+ scalarExpr d se <+>+ (if b then mempty else pretty "not")+ <+> pretty "in"+ <+> parens (case x of+ InList es -> commaSep $ map (scalarExpr d) es+ InQueryExpr qe -> queryExpr d qe)++scalarExpr d (Array v es) =+ scalarExpr d v <> brackets (commaSep $ map (scalarExpr d) es)++scalarExpr d (ArrayCtor q) =+ pretty "array" <> parens (queryExpr d q)++scalarExpr d (MultisetCtor es) =+ pretty "multiset" <> brackets (commaSep $ map (scalarExpr d) es)++scalarExpr d (MultisetQueryCtor q) =+ pretty "multiset" <> parens (queryExpr d q)++scalarExpr d (MultisetBinOp a c q b) =+ sep+ [scalarExpr d a+ ,pretty "multiset"+ ,pretty $ case c of+ Union -> "union"+ Intersect -> "intersect"+ Except -> "except"+ ,case q of+ SQDefault -> mempty+ All -> pretty "all"+ Distinct -> pretty "distinct"+ ,scalarExpr d b]++{-scalarExpr d (Escape v e) =+ scalarExpr d v <+> pretty "escape" <+> pretty [e]++scalarExpr d (UEscape v e) =+ scalarExpr d v <+> pretty "uescape" <+> pretty [e]-}++scalarExpr d (Collate v c) =+ scalarExpr d v <+> pretty "collate" <+> names c++scalarExpr _ (NextValueFor ns) =+ pretty "next value for" <+> names ns++scalarExpr d (VEComment cmt v) =+ vsep $ map comment cmt <> [scalarExpr d v]++scalarExpr _ (OdbcLiteral t s) =+ pretty "{" <> lt t <+> squotes (pretty s) <> pretty "}"+ where+ lt OLDate = pretty "d"+ lt OLTime = pretty "t"+ lt OLTimestamp = pretty "ts"++scalarExpr d (OdbcFunc e) =+ pretty "{fn" <+> scalarExpr d e <> pretty "}"++scalarExpr d (Convert t e Nothing) =+ pretty "convert(" <> typeName t <> pretty "," <+> scalarExpr d e <> pretty ")"+scalarExpr d (Convert t e (Just i)) =+ pretty "convert(" <> typeName t <> pretty "," <+> scalarExpr d e <> pretty "," <+> pretty (showText i) <> pretty ")"++unname :: Name -> Text+unname (Name Nothing n) = n+unname (Name (Just (s,e)) n) =+ s <> n <> e++unnames :: [Name] -> Text+unnames ns = T.intercalate "." $ map unname ns+++name :: Name -> Doc a+name (Name Nothing n) = pretty n+name (Name (Just (s,e)) n) = pretty s <> pretty n <> pretty e++names :: [Name] -> Doc a+names ns = hcat $ punctuate (pretty ".") $ map name ns++typeName :: TypeName -> Doc a+typeName (TypeName t) = names t+typeName (PrecTypeName t a) = names t <+> parens (pretty $ showText a)+typeName (PrecScaleTypeName t a b) =+ names t <+> parens (pretty (showText a) <+> comma <+> pretty (showText b))+typeName (PrecLengthTypeName t i m u) =+ names t+ <> parens (pretty (showText i)+ <> me (\case+ PrecK -> pretty "K"+ PrecM -> pretty "M"+ PrecG -> pretty "G"+ PrecT -> pretty "T"+ PrecP -> pretty "P") m+ <+> me (\case+ PrecCharacters -> pretty "CHARACTERS"+ PrecOctets -> pretty "OCTETS") u)+typeName (CharTypeName t i cs col) =+ (names t+ <> me (\x -> parens (pretty $ showText x)) i)+ <+> (if null cs+ then mempty+ else pretty "character set" <+> names cs)+ <+> (if null col+ then mempty+ else pretty "collate" <+> names col)+typeName (TimeTypeName t i tz) =+ (names t+ <> me (\x -> parens (pretty $ showText x)) i)+ <+> pretty (if tz+ then "with time zone"+ else "without time zone")+typeName (RowTypeName cs) =+ pretty "row" <> parens (commaSep $ map f cs)+ where+ f (n,t) = name n <+> typeName t+typeName (IntervalTypeName f t) =+ pretty "interval"+ <+> intervalTypeField f+ <+> me (\x -> pretty "to" <+> intervalTypeField x) t++typeName (ArrayTypeName tn sz) =+ typeName tn <+> pretty "array" <+> me (brackets . pretty . showText) sz++typeName (MultisetTypeName tn) =+ typeName tn <+> pretty "multiset"++intervalTypeField :: IntervalTypeField -> Doc a+intervalTypeField (Itf n p) =+ pretty n+ <+> me (\(x,x1) ->+ parens (pretty (showText x)+ <+> me (\y -> sep [comma,pretty (showText y)]) x1)) p+++-- = query expressions++queryExpr :: Dialect -> QueryExpr -> Doc a+queryExpr dia (Select d sl fr wh gb hv od off fe) =+ sep [pretty "select" <+> align (sep+ [case d of+ SQDefault -> mempty+ All -> pretty "all"+ Distinct -> pretty "distinct"+ ,selectList dia sl])+ ,from dia fr+ ,maybeScalarExpr dia "where" wh+ ,grpBy dia gb+ ,maybeScalarExpr dia "having" hv+ ,orderBy dia od+ ,me (\e -> pretty "offset" <+> scalarExpr dia e <+> pretty "rows") off+ ,fetchFirst+ ]+ where+ fetchFirst =+ me (\e -> if diLimit dia+ then pretty "limit" <+> scalarExpr dia e+ else pretty "fetch first" <+> scalarExpr dia e+ <+> pretty "rows only") fe++queryExpr dia (QueryExprSetOp q1 ct d c q2) =+ sep [queryExpr dia q1+ ,pretty (case ct of+ Union -> "union"+ Intersect -> "intersect"+ Except -> "except")+ <+> case d of+ SQDefault -> mempty+ All -> pretty "all"+ Distinct -> pretty "distinct"+ <+> case c of+ Corresponding -> pretty "corresponding"+ Respectively -> mempty+ ,queryExpr dia q2]+queryExpr d (With rc withs qe) =+ pretty "with" <+> (if rc then pretty "recursive" else mempty)+ <+> vsep [nest 5+ (vsep $ punctuate comma $ flip map withs $ \(n,q) ->+ withAlias n <+> pretty "as" <+> parens (queryExpr d q))+ ,queryExpr d qe]+ where+ withAlias (Alias nm cols) = name nm+ <+> me (parens . commaSep . map name) cols+++queryExpr d (Values vs) =+ pretty "values"+ <+> nest 7 (commaSep (map (parens . commaSep . map (scalarExpr d)) vs))+queryExpr _ (Table t) = pretty "table" <+> names t+queryExpr d (QEComment cmt v) =+ vsep $ map comment cmt <> [queryExpr d v]+++alias :: Alias -> Doc a+alias (Alias nm cols) =+ pretty "as" <+> name nm+ <+> me (parens . commaSep . map name) cols++selectList :: Dialect -> [(ScalarExpr,Maybe Name)] -> Doc a+selectList d is = commaSep $ map si is+ where+ si (e,al) = scalarExpr d e <+> me als al+ als al = pretty "as" <+> name al++from :: Dialect -> [TableRef] -> Doc a+from _ [] = mempty+from d ts =+ pretty "from" <+> align (vsep (punctuate comma $ map tr ts))+ where+ tr (TRSimple t) = names t+ tr (TRLateral t) = pretty "lateral" <+> tr t+ tr (TRFunction f as) =+ names f <> parens (commaSep $ map (scalarExpr d) as)+ tr (TRAlias t a) = sep [tr t, alias a]+ tr (TRParens t) = parens $ tr t+ tr (TRQueryExpr q) = parens $ queryExpr d q+ tr (TRJoin t0 b jt t1 jc) =+ sep [tr t0+ ,if b then pretty "natural" else mempty+ ,joinText jt <+> tr t1+ ,joinCond jc]+ tr (TROdbc t) = pretty "{oj" <+> tr t <+> pretty "}"+ joinText jt =+ sep [case jt of+ JInner -> pretty "inner"+ JLeft -> pretty "left"+ JRight -> pretty "right"+ JFull -> pretty "full"+ JCross -> pretty "cross"+ ,pretty "join"]+ joinCond (Just (JoinOn e)) = pretty "on" <+> scalarExpr d e+ joinCond (Just (JoinUsing es)) =+ pretty "using" <+> parens (commaSep $ map name es)+ joinCond Nothing = mempty++maybeScalarExpr :: Dialect -> Text -> Maybe ScalarExpr -> Doc a+maybeScalarExpr d k = me+ (\e -> pretty k <+> align (scalarExpr d e))++grpBy :: Dialect -> [GroupingExpr] -> Doc a+grpBy _ [] = mempty+grpBy d gs = pretty "group by" <+> align (commaSep $ map ge gs)+ where+ ge (SimpleGroup e) = scalarExpr d e+ ge (GroupingParens g) = parens (commaSep $ map ge g)+ ge (Cube es) = pretty "cube" <> parens (commaSep $ map ge es)+ ge (Rollup es) = pretty "rollup" <> parens (commaSep $ map ge es)+ ge (GroupingSets es) = pretty "grouping sets" <> parens (commaSep $ map ge es)++orderBy :: Dialect -> [SortSpec] -> Doc a+orderBy _ [] = mempty+orderBy dia os = pretty "order by" <+> align (commaSep $ map f os)+ where+ f (SortSpec e d n) =+ scalarExpr dia e+ <+> (case d of+ Asc -> pretty "asc"+ Desc -> pretty "desc"+ DirDefault -> mempty)+ <+> (case n of+ NullsOrderDefault -> mempty+ NullsFirst -> pretty "nulls" <+> pretty "first"+ NullsLast -> pretty "nulls" <+> pretty "last")++-- = statements++statement :: Dialect -> Statement -> Doc a+++-- == ddl++statement _ (CreateSchema nm) =+ pretty "create" <+> pretty "schema" <+> names nm++statement d (CreateTable nm cds) =+ pretty "create" <+> pretty "table" <+> names nm+ <+> parens (commaSep $ map cd cds)+ where+ cd (TableConstraintDef n con) =+ maybe mempty (\s -> pretty "constraint" <+> names s) n+ <+> tableConstraint d con+ cd (TableColumnDef cd') = columnDef d cd'++statement d (AlterTable t act) =+ texts ["alter","table"] <+> names t+ <+> alterTableAction d act++statement _ (DropSchema nm db) =+ pretty "drop" <+> pretty "schema" <+> names nm <+> dropBehav db++statement d (CreateDomain nm ty def cs) =+ pretty "create" <+> pretty "domain" <+> names nm+ <+> typeName ty+ <+> maybe mempty (\def' -> pretty "default" <+> scalarExpr d def') def+ <+> sep (map con cs)+ where+ con (cn, e) =+ maybe mempty (\cn' -> pretty "constraint" <+> names cn') cn+ <+> pretty "check" <> parens (scalarExpr d e)++statement d (AlterDomain nm act) =+ texts ["alter","domain"]+ <+> names nm+ <+> a act+ where+ a (ADSetDefault v) = texts ["set","default"] <+> scalarExpr d v+ a ADDropDefault = texts ["drop","default"]+ a (ADAddConstraint cnm e) =+ pretty "add"+ <+> maybe mempty (\cnm' -> pretty "constraint" <+> names cnm') cnm+ <+> pretty "check" <> parens (scalarExpr d e)+ a (ADDropConstraint cnm) = texts ["drop", "constraint"]+ <+> names cnm+++statement _ (DropDomain nm db) =+ pretty "drop" <+> pretty "domain" <+> names nm <+> dropBehav db++statement _ (CreateSequence nm sgos) =+ texts ["create","sequence"] <+> names nm+ <+> sep (map sequenceGeneratorOption sgos)++statement _ (AlterSequence nm sgos) =+ texts ["alter","sequence"] <+> names nm+ <+> sep (map sequenceGeneratorOption sgos)++statement _ (DropSequence nm db) =+ pretty "drop" <+> pretty "sequence" <+> names nm <+> dropBehav db+++statement d (CreateAssertion nm ex) =+ texts ["create","assertion"] <+> names nm+ <+> pretty "check" <+> parens (scalarExpr d ex)++statement _ (DropAssertion nm db) =+ pretty "drop" <+> pretty "assertion" <+> names nm <+> dropBehav db++statement _ (CreateIndex un nm tbl cols) =+ texts (if un+ then ["create","unique","index"]+ else ["create","index"])+ <+> names nm+ <+> pretty "on"+ <+> names tbl+ <+> parens (commaSep $ map name cols)++-- == dml++statement d (SelectStatement q) = queryExpr d q++statement d (Delete t a w) =+ pretty "delete" <+> pretty "from"+ <+> names t <+> maybe mempty (\x -> pretty "as" <+> name x) a+ <+> maybeScalarExpr d "where" w++statement _ (Truncate t ir) =+ pretty "truncate" <+> pretty "table" <+> names t+ <+> case ir of+ DefaultIdentityRestart -> mempty+ ContinueIdentity -> pretty "continue" <+> pretty "identity"+ RestartIdentity -> pretty "restart" <+> pretty "identity"++statement d (Insert t cs s) =+ pretty "insert" <+> pretty "into" <+> names t+ <+> maybe mempty (\cs' -> parens (commaSep $ map name cs')) cs+ <+> case s of+ DefaultInsertValues -> pretty "default" <+> pretty "values"+ InsertQuery q -> queryExpr d q++statement d (Update t a sts whr) =+ pretty "update" <+> names t+ <+> maybe mempty (\x -> pretty "as" <+> name x) a+ <+> pretty "set" <+> commaSep (map sc sts)+ <+> maybeScalarExpr d "where" whr+ where+ sc (Set tg v) = names tg <+> pretty "=" <+> scalarExpr d v+ sc (SetMultiple ts vs) = parens (commaSep $ map names ts) <+> pretty "="+ <+> parens (commaSep $ map (scalarExpr d) vs)++statement _ (DropTable n b) =+ pretty "drop" <+> pretty "table" <+> names n <+> dropBehav b++statement d (CreateView r nm al q co) =+ pretty "create" <+> (if r then pretty "recursive" else mempty)+ <+> pretty "view" <+> names nm+ <+> maybe mempty (parens . commaSep . map name) al+ <+> pretty "as"+ <+> queryExpr d q+ <+> case co of+ Nothing -> mempty+ Just DefaultCheckOption -> texts ["with", "check", "option"]+ Just CascadedCheckOption -> texts ["with", "cascaded", "check", "option"]+ Just LocalCheckOption -> texts ["with", "local", "check", "option"]++statement _ (DropView n b) =+ pretty "drop" <+> pretty "view" <+> names n <+> dropBehav b+++-- == transactions++statement _ StartTransaction =+ texts ["start", "transaction"]++statement _ (Savepoint nm) =+ pretty "savepoint" <+> name nm++statement _ (ReleaseSavepoint nm) =+ texts ["release", "savepoint"] <+> name nm++statement _ Commit =+ pretty "commit"++statement _ (Rollback mn) =+ pretty "rollback"+ <+> maybe mempty (\n -> texts ["to","savepoint"] <+> name n) mn++-- == access control++statement _ (GrantPrivilege pas po rs go) =+ pretty "grant" <+> commaSep (map privAct pas)+ <+> pretty "on" <+> privObj po+ <+> pretty "to" <+> commaSep (map name rs)+ <+> grantOpt go+ where+ grantOpt WithGrantOption = texts ["with","grant","option"]+ grantOpt WithoutGrantOption = mempty++statement _ (GrantRole rs trs ao) =+ pretty "grant" <+> commaSep (map name rs)+ <+> pretty "to" <+> commaSep (map name trs)+ <+> adminOpt ao+ where+ adminOpt WithAdminOption = texts ["with","admin","option"]+ adminOpt WithoutAdminOption = mempty++statement _ (CreateRole nm) =+ texts ["create","role"] <+> name nm++statement _ (DropRole nm) =+ texts ["drop","role"] <+> name nm++statement _ (RevokePrivilege go pas po rs db) =+ pretty "revoke"+ <+> grantOptFor go+ <+> commaSep (map privAct pas)+ <+> pretty "on" <+> privObj po+ <+> pretty "from" <+> commaSep (map name rs)+ <+> dropBehav db+ where+ grantOptFor GrantOptionFor = texts ["grant","option","for"]+ grantOptFor NoGrantOptionFor = mempty++statement _ (RevokeRole ao rs trs db) =+ pretty "revoke"+ <+> adminOptFor ao+ <+> commaSep (map name rs)+ <+> pretty "from" <+> commaSep (map name trs)+ <+> dropBehav db+ where+ adminOptFor AdminOptionFor = texts ["admin","option","for"]+ adminOptFor NoAdminOptionFor = mempty+++statement _ (StatementComment cs) = vsep $ map comment cs+statement _ EmptyStatement = mempty+++{-+== sessions+++== extras+-}++dropBehav :: DropBehaviour -> Doc a+dropBehav DefaultDropBehaviour = mempty+dropBehav Cascade = pretty "cascade"+dropBehav Restrict = pretty "restrict"+++columnDef :: Dialect -> ColumnDef -> Doc a+columnDef d (ColumnDef n t mdef cons) =+ name n <+> typeName t+ <+> case mdef of+ Nothing -> mempty+ Just (DefaultClause def) ->+ pretty "default" <+> scalarExpr d def+ Just (GenerationClause e) ->+ texts ["generated","always","as"] <+> parens (scalarExpr d e)+ Just (IdentityColumnSpec w o) ->+ pretty "generated"+ <+> (case w of+ GeneratedAlways -> pretty "always"+ GeneratedByDefault -> pretty "by" <+> pretty "default")+ <+> pretty "as" <+> pretty "identity"+ <+> (case o of+ [] -> mempty+ os -> parens (sep $ map sequenceGeneratorOption os))+ <+> sep (map cdef cons)+ where+ cdef (ColConstraintDef cnm con) =+ maybe mempty (\s -> pretty "constraint" <+> names s) cnm+ <+> pcon con+ pcon ColNotNullConstraint = texts ["not","null"]+ pcon ColNullableConstraint = texts ["null"]+ pcon ColUniqueConstraint = pretty "unique"+ pcon (ColPrimaryKeyConstraint autoincrement) = + texts $ ["primary","key"] <> ["autoincrement"|autoincrement]+ --pcon ColPrimaryKeyConstraint = texts ["primary","key"]+ pcon (ColCheckConstraint v) = pretty "check" <+> parens (scalarExpr d v)+ pcon (ColReferencesConstraint tb c m u del) =+ pretty "references"+ <+> names tb+ <+> maybe mempty (parens . name) c+ <+> refMatch m+ <+> refAct "update" u+ <+> refAct "delete" del++sequenceGeneratorOption :: SequenceGeneratorOption -> Doc a+sequenceGeneratorOption (SGODataType t) =+ pretty "as" <+> typeName t+sequenceGeneratorOption (SGORestart mi) =+ pretty "restart" <+> maybe mempty (\mi' -> texts ["with", showText mi']) mi+sequenceGeneratorOption (SGOStartWith i) = texts ["start", "with", showText i]+sequenceGeneratorOption (SGOIncrementBy i) = texts ["increment", "by", showText i]+sequenceGeneratorOption (SGOMaxValue i) = texts ["maxvalue", showText i]+sequenceGeneratorOption SGONoMaxValue = texts ["no", "maxvalue"]+sequenceGeneratorOption (SGOMinValue i) = texts ["minvalue", showText i]+sequenceGeneratorOption SGONoMinValue = texts ["no", "minvalue"]+sequenceGeneratorOption SGOCycle = pretty "cycle"+sequenceGeneratorOption SGONoCycle = pretty "no cycle"++refMatch :: ReferenceMatch -> Doc a+refMatch m = case m of+ DefaultReferenceMatch -> mempty+ MatchFull -> texts ["match", "full"]+ MatchPartial -> texts ["match","partial"]+ MatchSimple -> texts ["match", "simple"]++refAct :: Text -> ReferentialAction -> Doc a+refAct t a = case a of+ DefaultReferentialAction -> mempty+ RefCascade -> texts ["on", t, "cascade"]+ RefSetNull -> texts ["on", t, "set", "null"]+ RefSetDefault -> texts ["on", t, "set", "default"]+ RefRestrict -> texts ["on", t, "restrict"]+ RefNoAction -> texts ["on", t, "no", "action"]++alterTableAction :: Dialect -> AlterTableAction -> Doc a+alterTableAction d (AddColumnDef cd) =+ texts ["add", "column"] <+> columnDef d cd++alterTableAction d (AlterColumnSetDefault n v) =+ texts ["alter", "column"]+ <+> name n+ <+> texts ["set","default"] <+> scalarExpr d v+alterTableAction _ (AlterColumnDropDefault n) =+ texts ["alter", "column"]+ <+> name n+ <+> texts ["drop","default"]++alterTableAction _ (AlterColumnSetNotNull n) =+ texts ["alter", "column"]+ <+> name n+ <+> texts ["set","not","null"]++alterTableAction _ (AlterColumnDropNotNull n) =+ texts ["alter", "column"]+ <+> name n+ <+> texts ["drop","not","null"]++alterTableAction _ (AlterColumnSetDataType n t) =+ texts ["alter", "column"]+ <+> name n+ <+> texts ["set","data","Type"]+ <+> typeName t++alterTableAction _ (DropColumn n b) =+ texts ["drop", "column"]+ <+> name n+ <+> dropBehav b++alterTableAction d (AddTableConstraintDef n con) =+ pretty "add"+ <+> maybe mempty (\s -> pretty "constraint" <+> names s) n+ <+> tableConstraint d con++alterTableAction _ (DropTableConstraintDef n b) =+ texts ["drop", "constraint"]+ <+> names n+ <+> dropBehav b+++tableConstraint :: Dialect -> TableConstraint -> Doc a+tableConstraint _ (TableUniqueConstraint ns) =+ pretty "unique" <+> parens (commaSep $ map name ns)+tableConstraint _ (TablePrimaryKeyConstraint ns) =+ texts ["primary","key"] <+> parens (commaSep $ map name ns)+tableConstraint _ (TableReferencesConstraint cs t tcs m u del) =+ texts ["foreign", "key"]+ <+> parens (commaSep $ map name cs)+ <+> pretty "references"+ <+> names t+ <+> maybe mempty (\c' -> parens (commaSep $ map name c')) tcs+ <+> refMatch m+ <+> refAct "update" u+ <+> refAct "delete" del+tableConstraint d (TableCheckConstraint v) = pretty "check" <+> parens (scalarExpr d v)+++privAct :: PrivilegeAction -> Doc a+privAct PrivAll = texts ["all","privileges"]+privAct (PrivSelect cs) = pretty "select" <+> maybeColList cs+privAct (PrivInsert cs) = pretty "insert" <+> maybeColList cs+privAct (PrivUpdate cs) = pretty "update" <+> maybeColList cs+privAct (PrivReferences cs) = pretty "references" <+> maybeColList cs+privAct PrivDelete = pretty "delete"+privAct PrivUsage = pretty "usage"+privAct PrivTrigger = pretty "trigger"+privAct PrivExecute = pretty "execute"++maybeColList :: [Name] -> Doc a+maybeColList cs =+ if null cs+ then mempty+ else parens (commaSep $ map name cs)++privObj :: PrivilegeObject -> Doc a+privObj (PrivTable nm) = names nm+privObj (PrivDomain nm) = pretty "domain" <+> names nm+privObj (PrivType nm) = pretty "type" <+> names nm+privObj (PrivSequence nm) = pretty "sequence" <+> names nm+privObj (PrivFunction nm) = texts ["specific", "function"] <+> names nm++-- = utils++commaSep :: [Doc a] -> Doc a+commaSep ds = sep $ punctuate comma ds++me :: (b -> Doc a) -> Maybe b -> Doc a+me = maybe mempty++comment :: Comment -> Doc a+comment (BlockComment str) = pretty "/*" <+> pretty str <+> pretty "*/"++texts :: [Text] -> Doc a+texts ts = sep $ map pretty ts++-- regular pretty completely defeats the type checker when you want+-- to change the ast and get type errors, instead it just produces+-- incorrect code.+pretty :: Text -> Doc a+pretty = P.pretty++showText :: Show a => a -> Text+showText = T.pack . show++-- restore the correct behaviour of mempty+-- this doesn't quite work when you chain <> and <+> together,+-- so use parens in those cases++sep :: [Doc a] -> Doc a+sep = P.sep . filter isEmpty+ where+ isEmpty Empty = False+ isEmpty _ = True++(<+>) :: Doc a -> Doc a -> Doc a+(<+>) a b = case (a,b) of+ (Empty, Empty) -> Empty+ (Empty, x) -> x+ (x, Empty) -> x+ _ -> a P.<+> b++parens :: Doc a -> Doc a+parens a = P.parens (align a)
− Language/SQL/SimpleSQL/Pretty.lhs
@@ -1,820 +0,0 @@--> -- | These is the pretty printing functions, which produce SQL-> -- source from ASTs. The code attempts to format the output in a-> -- readable way.-> module Language.SQL.SimpleSQL.Pretty-> (prettyQueryExpr-> ,prettyScalarExpr-> ,prettyStatement-> ,prettyStatements-> ) where--> import Prelude hiding ((<>))--TODO: there should be more comments in this file, especially the bits-which have been changed to try to improve the layout of the output.-Try to do this when this code is ported to a modern pretty printing lib.--> --import Language.SQL.SimpleSQL.Dialect-> import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens,-> nest, Doc, punctuate, comma, sep, quotes,-> brackets,hcat)-> import Data.Maybe (maybeToList, catMaybes)-> import Data.List (intercalate)---> import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Dialect---> -- | Convert a query expr ast to concrete syntax.-> prettyQueryExpr :: Dialect -> QueryExpr -> String-> prettyQueryExpr d = render . queryExpr d--> -- | Convert a value expr ast to concrete syntax.-> prettyScalarExpr :: Dialect -> ScalarExpr -> String-> prettyScalarExpr d = render . scalarExpr d--> -- | Convert a statement ast to concrete syntax.-> prettyStatement :: Dialect -> Statement -> String-> prettyStatement d = render . statement d--> -- | Convert a list of statements to concrete syntax. A semicolon-> -- is inserted after each statement.-> prettyStatements :: Dialect -> [Statement] -> String-> prettyStatements d = render . vcat . map ((<> text ";\n") . statement d)--= scalar expressions--> scalarExpr :: Dialect -> ScalarExpr -> Doc-> scalarExpr _ (StringLit s e t) = text s <> text t <> text e--> scalarExpr _ (NumLit s) = text s-> scalarExpr _ (IntervalLit s v f t) =-> text "interval"-> <+> me (\x -> text $ case x of-> Plus -> "+"-> Minus -> "-") s-> <+> quotes (text v)-> <+> intervalTypeField f-> <+> me (\x -> text "to" <+> intervalTypeField x) t-> scalarExpr _ (Iden i) = names i-> scalarExpr _ Star = text "*"-> scalarExpr _ Parameter = text "?"-> scalarExpr _ (PositionalArg n) = text $ "$" ++ show n-> scalarExpr _ (HostParameter p i) =-> text p-> <+> me (\i' -> text "indicator" <+> text i') i--> scalarExpr d (App f es) = names f <> parens (commaSep (map (scalarExpr d) es))--> scalarExpr dia (AggregateApp f d es od fil) =-> names f-> <> parens ((case d of-> Distinct -> text "distinct"-> All -> text "all"-> SQDefault -> empty)-> <+> commaSep (map (scalarExpr dia) es)-> <+> orderBy dia od)-> <+> me (\x -> text "filter"-> <+> parens (text "where" <+> scalarExpr dia x)) fil--> scalarExpr d (AggregateAppGroup f es od) =-> names f-> <> parens (commaSep (map (scalarExpr d) es))-> <+> if null od-> then empty-> else text "within group" <+> parens (orderBy d od)--> scalarExpr d (WindowApp f es pb od fr) =-> names f <> parens (commaSep $ map (scalarExpr d) es)-> <+> text "over"-> <+> parens ((case pb of-> [] -> empty-> _ -> text "partition by"-> <+> nest 13 (commaSep $ map (scalarExpr d) pb))-> <+> orderBy d od-> <+> me frd fr)-> where-> frd (FrameFrom rs fp) = rsd rs <+> fpd fp-> frd (FrameBetween rs fps fpe) =-> rsd rs <+> text "between" <+> fpd fps-> <+> text "and" <+> fpd fpe-> rsd rs = case rs of-> FrameRows -> text "rows"-> FrameRange -> text "range"-> fpd UnboundedPreceding = text "unbounded preceding"-> fpd UnboundedFollowing = text "unbounded following"-> fpd Current = text "current row"-> fpd (Preceding e) = scalarExpr d e <+> text "preceding"-> fpd (Following e) = scalarExpr d e <+> text "following"--> scalarExpr dia (SpecialOp nm [a,b,c]) | nm `elem` [[Name Nothing "between"]-> ,[Name Nothing "not between"]] =-> sep [scalarExpr dia a-> ,names nm <+> scalarExpr dia b-> ,nest (length (unnames nm) + 1) $ text "and" <+> scalarExpr dia c]--> scalarExpr d (SpecialOp [Name Nothing "rowctor"] as) =-> parens $ commaSep $ map (scalarExpr d) as--> scalarExpr d (SpecialOp nm es) =-> names nm <+> parens (commaSep $ map (scalarExpr d) es)--> scalarExpr d (SpecialOpK nm fs as) =-> names nm <> parens (sep $ catMaybes-> (fmap (scalarExpr d) fs-> : map (\(n,e) -> Just (text n <+> scalarExpr d e)) as))--> scalarExpr d (PrefixOp f e) = names f <+> scalarExpr d e-> scalarExpr d (PostfixOp f e) = scalarExpr d e <+> names f-> scalarExpr d e@(BinOp _ op _) | op `elem` [[Name Nothing "and"]-> ,[Name Nothing "or"]] =-> -- special case for and, or, get all the ands so we can vcat them-> -- nicely-> case ands e of-> (e':es) -> vcat (scalarExpr d e'-> : map ((names op <+>) . scalarExpr d) es)-> [] -> empty -- shouldn't be possible-> where-> ands (BinOp a op' b) | op == op' = ands a ++ ands b-> ands x = [x]-> -- special case for . we don't use whitespace-> scalarExpr d (BinOp e0 [Name Nothing "."] e1) =-> scalarExpr d e0 <> text "." <> scalarExpr d e1-> scalarExpr d (BinOp e0 f e1) =-> scalarExpr d e0 <+> names f <+> scalarExpr d e1--> scalarExpr dia (Case t ws els) =-> sep $ [text "case" <+> me (scalarExpr dia) t]-> ++ map w ws-> ++ maybeToList (fmap e els)-> ++ [text "end"]-> where-> w (t0,t1) =-> text "when" <+> nest 5 (commaSep $ map (scalarExpr dia) t0)-> <+> text "then" <+> nest 5 (scalarExpr dia t1)-> e el = text "else" <+> nest 5 (scalarExpr dia el)-> scalarExpr d (Parens e) = parens $ scalarExpr d e-> scalarExpr d (Cast e tn) =-> text "cast" <> parens (sep [scalarExpr d e-> ,text "as"-> ,typeName tn])--> scalarExpr _ (TypedLit tn s) =-> typeName tn <+> quotes (text s)--> scalarExpr d (SubQueryExpr ty qe) =-> (case ty of-> SqSq -> empty-> SqExists -> text "exists"-> SqUnique -> text "unique"-> ) <+> parens (queryExpr d qe)--> scalarExpr d (QuantifiedComparison v c cp sq) =-> scalarExpr d v-> <+> names c-> <+> (text $ case cp of-> CPAny -> "any"-> CPSome -> "some"-> CPAll -> "all")-> <+> parens (queryExpr d sq)--> scalarExpr d (Match v u sq) =-> scalarExpr d v-> <+> text "match"-> <+> (if u then text "unique" else empty)-> <+> parens (queryExpr d sq)--> scalarExpr d (In b se x) =-> scalarExpr d se <+>-> (if b then empty else text "not")-> <+> text "in"-> <+> parens (nest (if b then 3 else 7) $-> case x of-> InList es -> commaSep $ map (scalarExpr d) es-> InQueryExpr qe -> queryExpr d qe)--> scalarExpr d (Array v es) =-> scalarExpr d v <> brackets (commaSep $ map (scalarExpr d) es)--> scalarExpr d (ArrayCtor q) =-> text "array" <> parens (queryExpr d q)--> scalarExpr d (MultisetCtor es) =-> text "multiset" <> brackets (commaSep $ map (scalarExpr d) es)--> scalarExpr d (MultisetQueryCtor q) =-> text "multiset" <> parens (queryExpr d q)--> scalarExpr d (MultisetBinOp a c q b) =-> sep-> [scalarExpr d a-> ,text "multiset"-> ,text $ case c of-> Union -> "union"-> Intersect -> "intersect"-> Except -> "except"-> ,case q of-> SQDefault -> empty-> All -> text "all"-> Distinct -> text "distinct"-> ,scalarExpr d b]--> {-scalarExpr d (Escape v e) =-> scalarExpr d v <+> text "escape" <+> text [e]--> scalarExpr d (UEscape v e) =-> scalarExpr d v <+> text "uescape" <+> text [e]-}--> scalarExpr d (Collate v c) =-> scalarExpr d v <+> text "collate" <+> names c--> scalarExpr _ (NextValueFor ns) =-> text "next value for" <+> names ns--> scalarExpr d (VEComment cmt v) =-> vcat $ map comment cmt ++ [scalarExpr d v]--> scalarExpr _ (OdbcLiteral t s) =-> text "{" <> lt t <+> quotes (text s) <> text "}"-> where-> lt OLDate = text "d"-> lt OLTime = text "t"-> lt OLTimestamp = text "ts"--> scalarExpr d (OdbcFunc e) =-> text "{fn" <+> scalarExpr d e <> text "}"--> unname :: Name -> String-> unname (Name Nothing n) = n-> unname (Name (Just (s,e)) n) =-> s ++ n ++ e--> unnames :: [Name] -> String-> unnames ns = intercalate "." $ map unname ns---> name :: Name -> Doc-> name (Name Nothing n) = text n-> name (Name (Just (s,e)) n) = text s <> text n <> text e--> names :: [Name] -> Doc-> names ns = hcat $ punctuate (text ".") $ map name ns--> typeName :: TypeName -> Doc-> typeName (TypeName t) = names t-> typeName (PrecTypeName t a) = names t <+> parens (text $ show a)-> typeName (PrecScaleTypeName t a b) =-> names t <+> parens (text (show a) <+> comma <+> text (show b))-> typeName (PrecLengthTypeName t i m u) =-> names t-> <> parens (text (show i)-> <> me (\x -> case x of-> PrecK -> text "K"-> PrecM -> text "M"-> PrecG -> text "G"-> PrecT -> text "T"-> PrecP -> text "P") m-> <+> me (\x -> case x of-> PrecCharacters -> text "CHARACTERS"-> PrecOctets -> text "OCTETS") u)-> typeName (CharTypeName t i cs col) =-> names t-> <> me (\x -> parens (text $ show x)) i-> <+> (if null cs-> then empty-> else text "character set" <+> names cs)-> <+> (if null col-> then empty-> else text "collate" <+> names col)-> typeName (TimeTypeName t i tz) =-> names t-> <> me (\x -> parens (text $ show x)) i-> <+> text (if tz-> then "with time zone"-> else "without time zone")-> typeName (RowTypeName cs) =-> text "row" <> parens (commaSep $ map f cs)-> where-> f (n,t) = name n <+> typeName t-> typeName (IntervalTypeName f t) =-> text "interval"-> <+> intervalTypeField f-> <+> me (\x -> text "to" <+> intervalTypeField x) t--> typeName (ArrayTypeName tn sz) =-> typeName tn <+> text "array" <+> me (brackets . text . show) sz--> typeName (MultisetTypeName tn) =-> typeName tn <+> text "multiset"--> intervalTypeField :: IntervalTypeField -> Doc-> intervalTypeField (Itf n p) =-> text n-> <+> me (\(x,x1) ->-> parens (text (show x)-> <+> me (\y -> (sep [comma,text (show y)])) x1)) p---= query expressions--> queryExpr :: Dialect -> QueryExpr -> Doc-> queryExpr dia (Select d sl fr wh gb hv od off fe) =-> sep [text "select"-> ,case d of-> SQDefault -> empty-> All -> text "all"-> Distinct -> text "distinct"-> ,nest 7 $ sep [selectList dia sl]-> ,from dia fr-> ,maybeScalarExpr dia "where" wh-> ,grpBy dia gb-> ,maybeScalarExpr dia "having" hv-> ,orderBy dia od-> ,me (\e -> text "offset" <+> scalarExpr dia e <+> text "rows") off-> ,fetchFirst-> ]-> where-> fetchFirst =-> me (\e -> if diLimit dia-> then text "limit" <+> scalarExpr dia e-> else text "fetch first" <+> scalarExpr dia e-> <+> text "rows only") fe--> queryExpr dia (QueryExprSetOp q1 ct d c q2) =-> sep [queryExpr dia q1-> ,text (case ct of-> Union -> "union"-> Intersect -> "intersect"-> Except -> "except")-> <+> case d of-> SQDefault -> empty-> All -> text "all"-> Distinct -> text "distinct"-> <+> case c of-> Corresponding -> text "corresponding"-> Respectively -> empty-> ,queryExpr dia q2]-> queryExpr d (With rc withs qe) =-> text "with" <+> (if rc then text "recursive" else empty)-> <+> vcat [nest 5-> (vcat $ punctuate comma $ flip map withs $ \(n,q) ->-> withAlias n <+> text "as" <+> parens (queryExpr d q))-> ,queryExpr d qe]-> where-> withAlias (Alias nm cols) = name nm-> <+> me (parens . commaSep . map name) cols---> queryExpr d (Values vs) =-> text "values"-> <+> nest 7 (commaSep (map (parens . commaSep . map (scalarExpr d)) vs))-> queryExpr _ (Table t) = text "table" <+> names t-> queryExpr d (QEComment cmt v) =-> vcat $ map comment cmt ++ [queryExpr d v]---> alias :: Alias -> Doc-> alias (Alias nm cols) =-> text "as" <+> name nm-> <+> me (parens . commaSep . map name) cols--> selectList :: Dialect -> [(ScalarExpr,Maybe Name)] -> Doc-> selectList d is = commaSep $ map si is-> where-> si (e,al) = scalarExpr d e <+> me als al-> als al = text "as" <+> name al--> from :: Dialect -> [TableRef] -> Doc-> from _ [] = empty-> from d ts =-> sep [text "from"-> ,nest 5 $ vcat $ punctuate comma $ map tr ts]-> where-> tr (TRSimple t) = names t-> tr (TRLateral t) = text "lateral" <+> tr t-> tr (TRFunction f as) =-> names f <> parens (commaSep $ map (scalarExpr d) as)-> tr (TRAlias t a) = sep [tr t, alias a]-> tr (TRParens t) = parens $ tr t-> tr (TRQueryExpr q) = parens $ queryExpr d q-> tr (TRJoin t0 b jt t1 jc) =-> sep [tr t0-> ,if b then text "natural" else empty-> ,joinText jt <+> tr t1-> ,joinCond jc]-> tr (TROdbc t) = text "{oj" <+> tr t <+> text "}"-> joinText jt =-> sep [case jt of-> JInner -> text "inner"-> JLeft -> text "left"-> JRight -> text "right"-> JFull -> text "full"-> JCross -> text "cross"-> ,text "join"]-> joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr d e-> joinCond (Just (JoinUsing es)) =-> text "using" <+> parens (commaSep $ map name es)-> joinCond Nothing = empty--> maybeScalarExpr :: Dialect -> String -> Maybe ScalarExpr -> Doc-> maybeScalarExpr d k = me-> (\e -> sep [text k-> ,nest (length k + 1) $ scalarExpr d e])--> grpBy :: Dialect -> [GroupingExpr] -> Doc-> grpBy _ [] = empty-> grpBy d gs = sep [text "group by"-> ,nest 9 $ commaSep $ map ge gs]-> where-> ge (SimpleGroup e) = scalarExpr d e-> ge (GroupingParens g) = parens (commaSep $ map ge g)-> ge (Cube es) = text "cube" <> parens (commaSep $ map ge es)-> ge (Rollup es) = text "rollup" <> parens (commaSep $ map ge es)-> ge (GroupingSets es) = text "grouping sets" <> parens (commaSep $ map ge es)--> orderBy :: Dialect -> [SortSpec] -> Doc-> orderBy _ [] = empty-> orderBy dia os = sep [text "order by"-> ,nest 9 $ commaSep $ map f os]-> where-> f (SortSpec e d n) =-> scalarExpr dia e-> <+> (case d of-> Asc -> text "asc"-> Desc -> text "desc"-> DirDefault -> empty)-> <+> (case n of-> NullsOrderDefault -> empty-> NullsFirst -> text "nulls" <+> text "first"-> NullsLast -> text "nulls" <+> text "last")--= statements--> statement :: Dialect -> Statement -> Doc---== ddl--> statement _ (CreateSchema nm) =-> text "create" <+> text "schema" <+> names nm--> statement d (CreateTable nm cds) =-> text "create" <+> text "table" <+> names nm-> <+> parens (commaSep $ map cd cds)-> where-> cd (TableConstraintDef n con) =-> maybe empty (\s -> text "constraint" <+> names s) n-> <+> tableConstraint d con-> cd (TableColumnDef cd') = columnDef d cd'--> statement d (AlterTable t act) =-> texts ["alter","table"] <+> names t-> <+> alterTableAction d act--> statement _ (DropSchema nm db) =-> text "drop" <+> text "schema" <+> names nm <+> dropBehav db--> statement d (CreateDomain nm ty def cs) =-> text "create" <+> text "domain" <+> names nm-> <+> typeName ty-> <+> maybe empty (\def' -> text "default" <+> scalarExpr d def') def-> <+> sep (map con cs)-> where-> con (cn, e) =-> maybe empty (\cn' -> text "constraint" <+> names cn') cn-> <+> text "check" <> parens (scalarExpr d e)--> statement d (AlterDomain nm act) =-> texts ["alter","domain"]-> <+> names nm-> <+> a act-> where-> a (ADSetDefault v) = texts ["set","default"] <+> scalarExpr d v-> a (ADDropDefault) = texts ["drop","default"]-> a (ADAddConstraint cnm e) =-> text "add"-> <+> maybe empty (\cnm' -> text "constraint" <+> names cnm') cnm-> <+> text "check" <> parens (scalarExpr d e)-> a (ADDropConstraint cnm) = texts ["drop", "constraint"]-> <+> names cnm---> statement _ (DropDomain nm db) =-> text "drop" <+> text "domain" <+> names nm <+> dropBehav db--> statement _ (CreateSequence nm sgos) =-> texts ["create","sequence"] <+> names nm-> <+> sep (map sequenceGeneratorOption sgos)--> statement _ (AlterSequence nm sgos) =-> texts ["alter","sequence"] <+> names nm-> <+> sep (map sequenceGeneratorOption sgos)--> statement _ (DropSequence nm db) =-> text "drop" <+> text "sequence" <+> names nm <+> dropBehav db---> statement d (CreateAssertion nm ex) =-> texts ["create","assertion"] <+> names nm-> <+> text "check" <+> parens (scalarExpr d ex)--> statement _ (DropAssertion nm db) =-> text "drop" <+> text "assertion" <+> names nm <+> dropBehav db--== dml--> statement d (SelectStatement q) = queryExpr d q--> statement d (Delete t a w) =-> text "delete" <+> text "from"-> <+> names t <+> maybe empty (\x -> text "as" <+> name x) a-> <+> maybeScalarExpr d "where" w--> statement _ (Truncate t ir) =-> text "truncate" <+> text "table" <+> names t-> <+> case ir of-> DefaultIdentityRestart -> empty-> ContinueIdentity -> text "continue" <+> text "identity"-> RestartIdentity -> text "restart" <+> text "identity"--> statement d (Insert t cs s) =-> text "insert" <+> text "into" <+> names t-> <+> maybe empty (\cs' -> parens (commaSep $ map name cs')) cs-> <+> case s of-> DefaultInsertValues -> text "default" <+> text "values"-> InsertQuery q -> queryExpr d q--> statement d (Update t a sts whr) =-> text "update" <+> names t-> <+> maybe empty (\x -> text "as" <+> name x) a-> <+> text "set" <+> commaSep (map sc sts)-> <+> maybeScalarExpr d "where" whr-> where-> sc (Set tg v) = names tg <+> text "=" <+> scalarExpr d v-> sc (SetMultiple ts vs) = parens (commaSep $ map names ts) <+> text "="-> <+> parens (commaSep $ map (scalarExpr d) vs)--> statement _ (DropTable n b) =-> text "drop" <+> text "table" <+> names n <+> dropBehav b--> statement d (CreateView r nm al q co) =-> text "create" <+> (if r then text "recursive" else empty)-> <+> text "view" <+> names nm-> <+> (maybe empty (\al' -> parens $ commaSep $ map name al')) al-> <+> text "as"-> <+> queryExpr d q-> <+> case co of-> Nothing -> empty-> Just DefaultCheckOption -> texts ["with", "check", "option"]-> Just CascadedCheckOption -> texts ["with", "cascaded", "check", "option"]-> Just LocalCheckOption -> texts ["with", "local", "check", "option"]--> statement _ (DropView n b) =-> text "drop" <+> text "view" <+> names n <+> dropBehav b---== transactions--> statement _ StartTransaction =-> texts ["start", "transaction"]--> statement _ (Savepoint nm) =-> text "savepoint" <+> name nm--> statement _ (ReleaseSavepoint nm) =-> texts ["release", "savepoint"] <+> name nm--> statement _ Commit =-> text "commit"--> statement _ (Rollback mn) =-> text "rollback"-> <+> maybe empty (\n -> texts ["to","savepoint"] <+> name n) mn--== access control--> statement _ (GrantPrivilege pas po rs go) =-> text "grant" <+> commaSep (map privAct pas)-> <+> text "on" <+> privObj po-> <+> text "to" <+> commaSep (map name rs)-> <+> grantOpt go-> where-> grantOpt WithGrantOption = texts ["with","grant","option"]-> grantOpt WithoutGrantOption = empty--> statement _ (GrantRole rs trs ao) =-> text "grant" <+> commaSep (map name rs)-> <+> text "to" <+> commaSep (map name trs)-> <+> adminOpt ao-> where-> adminOpt WithAdminOption = texts ["with","admin","option"]-> adminOpt WithoutAdminOption = empty--> statement _ (CreateRole nm) =-> texts ["create","role"] <+> name nm--> statement _ (DropRole nm) =-> texts ["drop","role"] <+> name nm--> statement _ (RevokePrivilege go pas po rs db) =-> text "revoke"-> <+> grantOptFor go-> <+> commaSep (map privAct pas)-> <+> text "on" <+> privObj po-> <+> text "from" <+> commaSep (map name rs)-> <+> dropBehav db-> where-> grantOptFor GrantOptionFor = texts ["grant","option","for"]-> grantOptFor NoGrantOptionFor = empty--> statement _ (RevokeRole ao rs trs db) =-> text "revoke"-> <+> adminOptFor ao-> <+> commaSep (map name rs)-> <+> text "from" <+> commaSep (map name trs)-> <+> dropBehav db-> where-> adminOptFor AdminOptionFor = texts ["admin","option","for"]-> adminOptFor NoAdminOptionFor = empty---> statement _ (StatementComment cs) = vcat $ map comment cs---== sessions---== extras--> dropBehav :: DropBehaviour -> Doc-> dropBehav DefaultDropBehaviour = empty-> dropBehav Cascade = text "cascade"-> dropBehav Restrict = text "restrict"---> columnDef :: Dialect -> ColumnDef -> Doc-> columnDef d (ColumnDef n t mdef cons) =-> name n <+> typeName t-> <+> case mdef of-> Nothing -> empty-> Just (DefaultClause def) ->-> text "default" <+> scalarExpr d def-> Just (GenerationClause e) ->-> texts ["generated","always","as"] <+> parens (scalarExpr d e)-> Just (IdentityColumnSpec w o) ->-> text "generated"-> <+> (case w of-> GeneratedAlways -> text "always"-> GeneratedByDefault -> text "by" <+> text "default")-> <+> text "as" <+> text "identity"-> <+> (case o of-> [] -> empty-> os -> parens (sep $ map sequenceGeneratorOption os))-> <+> sep (map cdef cons)-> where-> cdef (ColConstraintDef cnm con) =-> maybe empty (\s -> text "constraint" <+> names s) cnm-> <+> pcon con-> pcon ColNotNullConstraint = texts ["not","null"]-> pcon ColUniqueConstraint = text "unique"-> pcon ColPrimaryKeyConstraint = texts ["primary","key"]-> pcon (ColCheckConstraint v) = text "check" <+> parens (scalarExpr d v)-> pcon (ColReferencesConstraint tb c m u del) =-> text "references"-> <+> names tb-> <+> maybe empty (\c' -> parens (name c')) c-> <+> refMatch m-> <+> refAct "update" u-> <+> refAct "delete" del--> sequenceGeneratorOption :: SequenceGeneratorOption -> Doc-> sequenceGeneratorOption (SGODataType t) =-> text "as" <+> typeName t-> sequenceGeneratorOption (SGORestart mi) =-> text "restart" <+> maybe empty (\mi' -> texts ["with", show mi']) mi-> sequenceGeneratorOption (SGOStartWith i) = texts ["start", "with", show i]-> sequenceGeneratorOption (SGOIncrementBy i) = texts ["increment", "by", show i]-> sequenceGeneratorOption (SGOMaxValue i) = texts ["maxvalue", show i]-> sequenceGeneratorOption SGONoMaxValue = texts ["no", "maxvalue"]-> sequenceGeneratorOption (SGOMinValue i) = texts ["minvalue", show i]-> sequenceGeneratorOption SGONoMinValue = texts ["no", "minvalue"]-> sequenceGeneratorOption SGOCycle = text "cycle"-> sequenceGeneratorOption SGONoCycle = text "no cycle"--> refMatch :: ReferenceMatch -> Doc-> refMatch m = case m of-> DefaultReferenceMatch -> empty-> MatchFull -> texts ["match", "full"]-> MatchPartial -> texts ["match","partial"]-> MatchSimple -> texts ["match", "simple"]--> refAct :: String -> ReferentialAction -> Doc-> refAct t a = case a of-> DefaultReferentialAction -> empty-> RefCascade -> texts ["on", t, "cascade"]-> RefSetNull -> texts ["on", t, "set", "null"]-> RefSetDefault -> texts ["on", t, "set", "default"]-> RefRestrict -> texts ["on", t, "restrict"]-> RefNoAction -> texts ["on", t, "no", "action"]--> alterTableAction :: Dialect -> AlterTableAction -> Doc-> alterTableAction d (AddColumnDef cd) =-> texts ["add", "column"] <+> columnDef d cd--> alterTableAction d (AlterColumnSetDefault n v) =-> texts ["alter", "column"]-> <+> name n-> <+> texts ["set","default"] <+> scalarExpr d v-> alterTableAction _ (AlterColumnDropDefault n) =-> texts ["alter", "column"]-> <+> name n-> <+> texts ["drop","default"]--> alterTableAction _ (AlterColumnSetNotNull n) =-> texts ["alter", "column"]-> <+> name n-> <+> texts ["set","not","null"]--> alterTableAction _ (AlterColumnDropNotNull n) =-> texts ["alter", "column"]-> <+> name n-> <+> texts ["drop","not","null"]--> alterTableAction _ (AlterColumnSetDataType n t) =-> texts ["alter", "column"]-> <+> name n-> <+> texts ["set","data","Type"]-> <+> typeName t--> alterTableAction _ (DropColumn n b) =-> texts ["drop", "column"]-> <+> name n-> <+> dropBehav b--> alterTableAction d (AddTableConstraintDef n con) =-> text "add"-> <+> maybe empty (\s -> text "constraint" <+> names s) n-> <+> tableConstraint d con--> alterTableAction _ (DropTableConstraintDef n b) =-> texts ["drop", "constraint"]-> <+> names n-> <+> dropBehav b---> tableConstraint :: Dialect -> TableConstraint -> Doc-> tableConstraint _ (TableUniqueConstraint ns) =-> text "unique" <+> parens (commaSep $ map name ns)-> tableConstraint _ (TablePrimaryKeyConstraint ns) =-> texts ["primary","key"] <+> parens (commaSep $ map name ns)-> tableConstraint _ (TableReferencesConstraint cs t tcs m u del) =-> texts ["foreign", "key"]-> <+> parens (commaSep $ map name cs)-> <+> text "references"-> <+> names t-> <+> maybe empty (\c' -> parens (commaSep $ map name c')) tcs-> <+> refMatch m-> <+> refAct "update" u-> <+> refAct "delete" del-> tableConstraint d (TableCheckConstraint v) = text "check" <+> parens (scalarExpr d v)---> privAct :: PrivilegeAction -> Doc-> privAct PrivAll = texts ["all","privileges"]-> privAct (PrivSelect cs) = text "select" <+> maybeColList cs-> privAct (PrivInsert cs) = text "insert" <+> maybeColList cs-> privAct (PrivUpdate cs) = text "update" <+> maybeColList cs-> privAct (PrivReferences cs) = text "references" <+> maybeColList cs-> privAct PrivDelete = text "delete"-> privAct PrivUsage = text "usage"-> privAct PrivTrigger = text "trigger"-> privAct PrivExecute = text "execute"--> maybeColList :: [Name] -> Doc-> maybeColList cs =-> if null cs-> then empty-> else parens (commaSep $ map name cs)--> privObj :: PrivilegeObject -> Doc-> privObj (PrivTable nm) = names nm-> privObj (PrivDomain nm) = text "domain" <+> names nm-> privObj (PrivType nm) = text "type" <+> names nm-> privObj (PrivSequence nm) = text "sequence" <+> names nm-> privObj (PrivFunction nm) = texts ["specific", "function"] <+> names nm--= utils--> commaSep :: [Doc] -> Doc-> commaSep ds = sep $ punctuate comma ds--> me :: (a -> Doc) -> Maybe a -> Doc-> me = maybe empty--> comment :: Comment -> Doc-> comment (BlockComment str) = text "/*" <+> text str <+> text "*/"--> texts :: [String] -> Doc-> texts ts = sep $ map text ts
+ Language/SQL/SimpleSQL/Syntax.hs view
@@ -0,0 +1,771 @@++-- | The AST for SQL.+{-# LANGUAGE DeriveDataTypeable #-}+module Language.SQL.SimpleSQL.Syntax+ (-- * Scalar expressions+ ScalarExpr(..)+ ,Name(..)+ ,TypeName(..)+ ,IntervalTypeField(..)+ ,Sign(..)+ ,PrecMultiplier(..)+ ,PrecUnits(..)+ ,SetQuantifier(..)+ ,SortSpec(..)+ ,Direction(..)+ ,NullsOrder(..)+ ,InPredValue(..)+ ,SubQueryExprType(..)+ ,CompPredQuantifier(..)+ ,Frame(..)+ ,FrameRows(..)+ ,FramePos(..)+ ,OdbcLiteralType(..)+ -- * Query expressions+ ,QueryExpr(..)+ ,SetOperatorName(..)+ ,Corresponding(..)+ ,Alias(..)+ ,GroupingExpr(..)+ -- ** From+ ,TableRef(..)+ ,JoinType(..)+ ,JoinCondition(..)+ -- * Statements+ ,Statement(..)+ ,DropBehaviour(..)+ ,IdentityRestart(..)+ ,InsertSource(..)+ ,SetClause(..)+ ,TableElement(..)+ ,ColumnDef(..)+ ,DefaultClause(..)+ ,IdentityWhen(..)+ ,SequenceGeneratorOption(..)+ ,ColConstraintDef(..)+ ,AutoincrementClause+ ,ColConstraint(..)+ ,TableConstraint(..)+ ,ReferenceMatch(..)+ ,ReferentialAction(..)+ ,AlterTableAction(..)+ ,CheckOption(..)+ ,AlterDomainAction(..)+ ,AdminOption(..)+ ,GrantOption(..)+ ,PrivilegeObject(..)+ ,PrivilegeAction(..)+ ,AdminOptionFor(..)+ ,GrantOptionFor(..)+ -- * Comment+ ,Comment(..)++ ,makeSelect+ ,toQueryExpr+ ,MakeSelect(..)+ ) where++import Data.Text (Text)++import Data.Data (Data, Typeable)++-- | Represents a value expression. This is used for the expressions+-- in select lists. It is also used for expressions in where, group+-- by, having, order by and so on.+data ScalarExpr+ = -- | a numeric literal optional decimal point, e+-+ -- integral exponent, e.g+ --+ -- * 10+ --+ -- * 10.+ --+ -- * .1+ --+ -- * 10.1+ --+ -- * 1e5+ --+ -- * 12.34e-6+ NumLit Text+ -- | string literal, with the start and end quote+ -- e.g. 'test' -> TextLit "'" "'" "test"+ | StringLit Text Text Text+ -- | text of interval literal, units of interval precision,+ -- e.g. interval 3 days (3)+ | IntervalLit+ {ilSign :: Maybe Sign -- ^ if + or - used+ ,ilLiteral :: Text -- ^ literal text+ ,ilFrom :: IntervalTypeField+ ,ilTo :: Maybe IntervalTypeField+ }++ -- | prefix 'typed literal', e.g. int '42'+ | TypedLit TypeName Text++ -- | identifier with parts separated by dots+ | Iden [Name]+ -- | star, as in select *, t.*, count(*)+ | Star++ | Parameter -- ^ Represents a ? in a parameterized query+ | PositionalArg Int -- ^ Represents an e.g. $1 in a parameterized query+ | HostParameter Text (Maybe Text) -- ^ represents a host+ -- parameter, e.g. :a. The+ -- Maybe Text is for the+ -- indicator, e.g. :var+ -- indicator :nl+++ -- | Infix binary operators. This is used for symbol operators+ -- (a + b), keyword operators (a and b) and multiple keyword+ -- operators (a is similar to b)+ | BinOp ScalarExpr [Name] ScalarExpr+ -- | Prefix unary operators. This is used for symbol+ -- operators, keyword operators and multiple keyword operators.+ | PrefixOp [Name] ScalarExpr+ -- | Postfix unary operators. This is used for symbol+ -- operators, keyword operators and multiple keyword operators.+ | PostfixOp [Name] ScalarExpr+ -- | Used for ternary, mixfix and other non orthodox+ -- operators. Currently used for row constructors, and for+ -- between.+ | SpecialOp [Name] [ScalarExpr]++ -- | function application (anything that looks like c style+ -- function application syntactically)+ | App [Name] [ScalarExpr]+++ -- | aggregate application, which adds distinct or all, and+ -- order by, to regular function application+ | AggregateApp+ {aggName :: [Name] -- ^ aggregate function name+ ,aggDistinct :: SetQuantifier -- ^ distinct+ ,aggArgs :: [ScalarExpr]-- ^ args+ ,aggOrderBy :: [SortSpec] -- ^ order by+ ,aggFilter :: Maybe ScalarExpr -- ^ filter+ }+ -- | aggregates with within group+ | AggregateAppGroup+ {aggName :: [Name] -- ^ aggregate function name+ ,aggArgs :: [ScalarExpr] -- ^ args+ ,aggGroup :: [SortSpec] -- ^ within group+ }+ -- | window application, which adds over (partition by a order+ -- by b) to regular function application. Explicit frames are+ -- not currently supported+ | WindowApp+ {wnName :: [Name] -- ^ window function name+ ,wnArgs :: [ScalarExpr] -- ^ args+ ,wnPartition :: [ScalarExpr] -- ^ partition by+ ,wnOrderBy :: [SortSpec] -- ^ order by+ ,wnFrame :: Maybe Frame -- ^ frame clause+ }++ -- | Used for the operators which look like functions+ -- except the arguments are separated by keywords instead+ -- of commas. The maybe is for the first unnamed argument+ -- if it is present, and the list is for the keyword argument+ -- pairs.+ | SpecialOpK [Name] (Maybe ScalarExpr) [(Text,ScalarExpr)]++ -- | cast(a as typename)+ | Cast ScalarExpr TypeName++ -- | convert expression to given datatype @CONVERT(data_type(length), expression, style)@+ | Convert TypeName ScalarExpr (Maybe Integer)++ -- | case expression. both flavours supported+ | Case+ {caseTest :: Maybe ScalarExpr -- ^ test value+ ,caseWhens :: [([ScalarExpr],ScalarExpr)] -- ^ when branches+ ,caseElse :: Maybe ScalarExpr -- ^ else value+ }++ | Parens ScalarExpr++ -- | in list literal and in subquery, if the bool is false it+ -- means not in was used ('a not in (1,2)')+ | In Bool ScalarExpr InPredValue++ -- | exists, all, any, some subqueries+ | SubQueryExpr SubQueryExprType QueryExpr++ | QuantifiedComparison+ ScalarExpr+ [Name] -- operator+ CompPredQuantifier+ QueryExpr++ | Match ScalarExpr Bool -- true if unique+ QueryExpr+ | Array ScalarExpr [ScalarExpr] -- ^ represents an array+ -- access expression, or an array ctor+ -- e.g. a[3]. The first+ -- scalarExpr is the array, the+ -- second is the subscripts/ctor args+ | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t)++{-+todo: special syntax for like, similar with escape - escape cannot go+in other places+-}++ -- | Escape ScalarExpr Char+ -- | UEscape ScalarExpr Char+ | Collate ScalarExpr [Name]+ | MultisetBinOp ScalarExpr SetOperatorName SetQuantifier ScalarExpr+ | MultisetCtor [ScalarExpr]+ | MultisetQueryCtor QueryExpr+ | NextValueFor [Name]+ | VEComment [Comment] ScalarExpr+ | OdbcLiteral OdbcLiteralType Text+ -- ^ an odbc literal e.g. {d '2000-01-01'}+ | OdbcFunc ScalarExpr+ -- ^ an odbc function call e.g. {fn CHARACTER_LENGTH('test')}+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents an identifier name, which can be quoted or unquoted.+-- examples:+--+-- * test -> Name Nothing "test"+-- * "test" -> Name (Just "\"","\"") "test"+-- * `something` -> Name (Just ("`","`") "something"+-- * [ms] -> Name (Just ("[","]") "ms"+data Name = Name (Maybe (Text,Text)) Text+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents a type name, used in casts.+data TypeName+ = TypeName [Name]+ | PrecTypeName [Name] Integer+ | PrecScaleTypeName [Name] Integer Integer+ | PrecLengthTypeName [Name] Integer (Maybe PrecMultiplier) (Maybe PrecUnits)+ -- precision, characterset, collate+ | CharTypeName [Name] (Maybe Integer) [Name] [Name]+ | TimeTypeName [Name] (Maybe Integer) Bool -- true == with time zone+ | RowTypeName [(Name,TypeName)]+ | IntervalTypeName IntervalTypeField (Maybe IntervalTypeField)+ | ArrayTypeName TypeName (Maybe Integer)+ | MultisetTypeName TypeName+ deriving (Eq,Show,Read,Data,Typeable)++data IntervalTypeField = Itf Text (Maybe (Integer, Maybe Integer))+ deriving (Eq,Show,Read,Data,Typeable)++data Sign = Plus | Minus+ deriving (Eq,Show,Read,Data,Typeable)++data PrecMultiplier = PrecK | PrecM | PrecG | PrecT | PrecP+ deriving (Eq,Show,Read,Data,Typeable)+data PrecUnits = PrecCharacters+ | PrecOctets+ deriving (Eq,Show,Read,Data,Typeable)++-- | Used for 'expr in (scalar expression list)', and 'expr in+-- (subquery)' syntax.+data InPredValue = InList [ScalarExpr]+ | InQueryExpr QueryExpr+ deriving (Eq,Show,Read,Data,Typeable)++-- not sure if scalar subquery, exists and unique should be represented like this++-- | A subquery in a scalar expression.+data SubQueryExprType+ = -- | exists (query expr)+ SqExists+ -- | unique (query expr)+ | SqUnique+ -- | a scalar subquery+ | SqSq+ deriving (Eq,Show,Read,Data,Typeable)++data CompPredQuantifier+ = CPAny+ | CPSome+ | CPAll+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents one field in an order by list.+data SortSpec = SortSpec ScalarExpr Direction NullsOrder+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents 'nulls first' or 'nulls last' in an order by clause.+data NullsOrder = NullsOrderDefault+ | NullsFirst+ | NullsLast+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents the frame clause of a window+-- this can be [range | rows] frame_start+-- or [range | rows] between frame_start and frame_end+data Frame = FrameFrom FrameRows FramePos+ | FrameBetween FrameRows FramePos FramePos+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents whether a window frame clause is over rows or ranges.+data FrameRows = FrameRows | FrameRange+ deriving (Eq,Show,Read,Data,Typeable)++-- | represents the start or end of a frame+data FramePos = UnboundedPreceding+ | Preceding ScalarExpr+ | Current+ | Following ScalarExpr+ | UnboundedFollowing+ deriving (Eq,Show,Read,Data,Typeable)+++-- | the type of an odbc literal (e.g. {d '2000-01-01'}),+-- correpsonding to the letter after the opening {+data OdbcLiteralType = OLDate+ | OLTime+ | OLTimestamp+ deriving (Eq,Show,Read,Data,Typeable)+++-- | Represents a query expression, which can be:+--+-- * a regular select;+--+-- * a set operator (union, except, intersect);+--+-- * a common table expression (with);+--+-- * a table value constructor (values (1,2),(3,4)); or+--+-- * an explicit table (table t).+data QueryExpr+ = Select+ {qeSetQuantifier :: SetQuantifier+ ,qeSelectList :: [(ScalarExpr,Maybe Name)]+ -- ^ the expressions and the column aliases++{-+TODO: consider breaking this up. The SQL grammar has+queryexpr = select <select list> [<table expression>]+table expression = <from> [where] [groupby] [having] ...++This would make some things a bit cleaner?+-}++ ,qeFrom :: [TableRef]+ ,qeWhere :: Maybe ScalarExpr+ ,qeGroupBy :: [GroupingExpr]+ ,qeHaving :: Maybe ScalarExpr+ ,qeOrderBy :: [SortSpec]+ ,qeOffset :: Maybe ScalarExpr+ ,qeFetchFirst :: Maybe ScalarExpr+ }+ | QueryExprSetOp+ {qe0 :: QueryExpr+ ,qeCombOp :: SetOperatorName+ ,qeSetQuantifier :: SetQuantifier+ ,qeCorresponding :: Corresponding+ ,qe1 :: QueryExpr+ }+ | With+ {qeWithRecursive :: Bool+ ,qeViews :: [(Alias,QueryExpr)]+ ,qeQueryExpression :: QueryExpr}+ | Values [[ScalarExpr]]+ | Table [Name]+ | QEComment [Comment] QueryExpr+ deriving (Eq,Show,Read,Data,Typeable)++{-+TODO: add queryexpr parens to deal with e.g.+(select 1 union select 2) union select 3+I'm not sure if this is valid syntax or not.+-}++-- | Represents the Distinct or All keywords, which can be used+-- before a select list, in an aggregate/window function+-- application, or in a query expression set operator.+data SetQuantifier = SQDefault | Distinct | All deriving (Eq,Show,Read,Data,Typeable)++-- | The direction for a column in order by.+data Direction = DirDefault | Asc | Desc deriving (Eq,Show,Read,Data,Typeable)+-- | Query expression set operators.+data SetOperatorName = Union | Except | Intersect deriving (Eq,Show,Read,Data,Typeable)+-- | Corresponding, an option for the set operators.+data Corresponding = Corresponding | Respectively deriving (Eq,Show,Read,Data,Typeable)++-- | Represents an item in a group by clause.+data GroupingExpr+ = GroupingParens [GroupingExpr]+ | Cube [GroupingExpr]+ | Rollup [GroupingExpr]+ | GroupingSets [GroupingExpr]+ | SimpleGroup ScalarExpr+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents a entry in the csv of tables in the from clause.+data TableRef = -- | from t / from s.t+ TRSimple [Name]+ -- | from a join b, the bool is true if natural was used+ | TRJoin TableRef Bool JoinType TableRef (Maybe JoinCondition)+ -- | from (a)+ | TRParens TableRef+ -- | from a as b(c,d)+ | TRAlias TableRef Alias+ -- | from (query expr)+ | TRQueryExpr QueryExpr+ -- | from function(args)+ | TRFunction [Name] [ScalarExpr]+ -- | from lateral t+ | TRLateral TableRef+ -- | ODBC {oj t1 left outer join t2 on expr} syntax+ | TROdbc TableRef+ deriving (Eq,Show,Read,Data,Typeable)++-- | Represents an alias for a table valued expression, used in with+-- queries and in from alias, e.g. select a from t u, select a from t u(b),+-- with a(c) as select 1, select * from a.+data Alias = Alias Name (Maybe [Name])+ deriving (Eq,Show,Read,Data,Typeable)++-- | The type of a join.+data JoinType = JInner | JLeft | JRight | JFull | JCross+ deriving (Eq,Show,Read,Data,Typeable)++-- | The join condition.+data JoinCondition = JoinOn ScalarExpr -- ^ on expr+ | JoinUsing [Name] -- ^ using (column list)+ deriving (Eq,Show,Read,Data,Typeable)++-- ---------------------------++data Statement =+ -- ddl+ CreateSchema [Name]+ | DropSchema [Name] DropBehaviour+ | CreateTable [Name] [TableElement]+ | AlterTable [Name] AlterTableAction+ | DropTable [Name] DropBehaviour+ | CreateIndex Bool [Name] [Name] [Name]+ | CreateView Bool [Name] (Maybe [Name])+ QueryExpr (Maybe CheckOption)+ | DropView [Name] DropBehaviour+ | CreateDomain [Name] TypeName (Maybe ScalarExpr)+ [(Maybe [Name], ScalarExpr)]+ | AlterDomain [Name] AlterDomainAction+ | DropDomain [Name] DropBehaviour++ -- probably won't do character sets, collations+ -- and translations because I think they are too far from+ -- reality+ {- | CreateCharacterSet+ | DropCharacterSet+ | CreateCollation+ | DropCollation+ | CreateTranslation+ | DropTranslation -}+ | CreateAssertion [Name] ScalarExpr+ | DropAssertion [Name] DropBehaviour+ {- | CreateTrigger+ | DropTrigger+ | CreateType+ | AlterType+ | DropType+ -- routine stuff? TODO+ | CreateCast+ | DropCast+ | CreateOrdering+ | DropOrdering -}+ -- transforms+ | CreateSequence [Name] [SequenceGeneratorOption]+ | AlterSequence [Name] [SequenceGeneratorOption]+ | DropSequence [Name] DropBehaviour+ -- dml+ | SelectStatement QueryExpr+ {- | DeclareCursor+ | OpenCursor+ | FetchCursor+ | CloseCursor+ | SelectInto -}+ -- | DeletePositioned+ | Delete [Name] (Maybe Name) (Maybe ScalarExpr)+ | Truncate [Name] IdentityRestart+ | Insert [Name] (Maybe [Name]) InsertSource+ -- | Merge+ | Update [Name] (Maybe Name) [SetClause] (Maybe ScalarExpr)+ {- | TemporaryTable+ | FreeLocator+ | HoldLocator -}+ -- access control+ | GrantPrivilege [PrivilegeAction] PrivilegeObject [Name] GrantOption+ | GrantRole [Name] [Name] AdminOption+ | CreateRole Name+ | DropRole Name+ | RevokePrivilege GrantOptionFor [PrivilegeAction] PrivilegeObject+ [Name] DropBehaviour+ | RevokeRole AdminOptionFor [Name] [Name] DropBehaviour+ -- transaction management+ | StartTransaction+ -- | SetTransaction+ -- | SetContraints+ | Savepoint Name+ | ReleaseSavepoint Name+ | Commit+ | Rollback (Maybe Name)+ -- session+ {- | SetSessionCharacteristics+ | SetSessionAuthorization+ | SetRole+ | SetTimeZone+ | SetCatalog+ | SetSchema+ | SetNames+ | SetTransform+ | SetCollation -}+ | StatementComment [Comment]+ | EmptyStatement+ deriving (Eq,Show,Read,Data,Typeable)++data DropBehaviour =+ Restrict+ | Cascade+ | DefaultDropBehaviour+ deriving (Eq,Show,Read,Data,Typeable)++data IdentityRestart =+ ContinueIdentity+ | RestartIdentity+ | DefaultIdentityRestart+ deriving (Eq,Show,Read,Data,Typeable)++data InsertSource =+ InsertQuery QueryExpr+ | DefaultInsertValues+ deriving (Eq,Show,Read,Data,Typeable)++data SetClause =+ Set [Name] ScalarExpr+ | SetMultiple [[Name]] [ScalarExpr]+ deriving (Eq,Show,Read,Data,Typeable)++data TableElement =+ TableColumnDef ColumnDef+ | TableConstraintDef (Maybe [Name]) TableConstraint+ deriving (Eq,Show,Read,Data,Typeable)++data ColumnDef = ColumnDef Name TypeName+ (Maybe DefaultClause)+ [ColConstraintDef]+ -- (Maybe CollateClause)+ deriving (Eq,Show,Read,Data,Typeable)++data ColConstraintDef =+ ColConstraintDef (Maybe [Name]) ColConstraint+ -- (Maybe [ConstraintCharacteristics])+ deriving (Eq,Show,Read,Data,Typeable)++type AutoincrementClause = Bool++data ColConstraint =+ ColNullableConstraint+ | ColNotNullConstraint+ | ColUniqueConstraint+ | ColPrimaryKeyConstraint AutoincrementClause+ | ColReferencesConstraint [Name] (Maybe Name)+ ReferenceMatch+ ReferentialAction+ ReferentialAction+ | ColCheckConstraint ScalarExpr+ deriving (Eq,Show,Read,Data,Typeable)++data TableConstraint =+ TableUniqueConstraint [Name]+ | TablePrimaryKeyConstraint [Name]+ | TableReferencesConstraint [Name] [Name] (Maybe [Name])+ ReferenceMatch+ ReferentialAction+ ReferentialAction+ | TableCheckConstraint ScalarExpr+ deriving (Eq,Show,Read,Data,Typeable)+++data ReferenceMatch =+ DefaultReferenceMatch+ | MatchFull+ | MatchPartial+ | MatchSimple+ deriving (Eq,Show,Read,Data,Typeable)++data ReferentialAction =+ DefaultReferentialAction+ | RefCascade+ | RefSetNull+ | RefSetDefault+ | RefRestrict+ | RefNoAction+ deriving (Eq,Show,Read,Data,Typeable)++data AlterTableAction =+ AddColumnDef ColumnDef+ | AlterColumnSetDefault Name ScalarExpr+ | AlterColumnDropDefault Name+ | AlterColumnSetNotNull Name+ | AlterColumnDropNotNull Name+ | AlterColumnSetDataType Name TypeName+ {- | AlterColumnAlterIdentity+ | AlterColumnDropIdentity+ | AlterColumnDropColumnGeneration-}+ | DropColumn Name DropBehaviour+ | AddTableConstraintDef (Maybe [Name]) TableConstraint+ -- | AlterTableConstraintDef+ | DropTableConstraintDef [Name] DropBehaviour+ deriving (Eq,Show,Read,Data,Typeable)++{-data ConstraintCharacteristics =+ ConstraintCharacteristics+ ConstraintCheckTime+ Deferrable+ ConstraintEnforcement+ deriving (Eq,Show,Read,Data,Typeable)++data ConstraintCheckTime =+ DefaultConstraintCheckTime+ | InitiallyDeferred+ | InitiallyImmeditate+ deriving (Eq,Show,Read,Data,Typeable)++data Deferrable =+ DefaultDefferable+ | Deferrable+ | NotDeferrable+ deriving (Eq,Show,Read,Data,Typeable)++data ConstraintEnforcement =+ DefaultConstraintEnforcement+ | Enforced+ | NotEnforced+ deriving (Eq,Show,Read,Data,Typeable) -}++{-data TableConstraintDef+ deriving (Eq,Show,Read,Data,Typeable) -}++data DefaultClause =+ DefaultClause ScalarExpr+ | IdentityColumnSpec IdentityWhen [SequenceGeneratorOption]+ | GenerationClause ScalarExpr+ deriving (Eq,Show,Read,Data,Typeable)++data IdentityWhen =+ GeneratedAlways+ | GeneratedByDefault+ deriving (Eq,Show,Read,Data,Typeable)++data SequenceGeneratorOption =+ SGODataType TypeName+ | SGOStartWith Integer+ | SGORestart (Maybe Integer)+ | SGOIncrementBy Integer+ | SGOMaxValue Integer+ | SGONoMaxValue+ | SGOMinValue Integer+ | SGONoMinValue+ | SGOCycle+ | SGONoCycle+ deriving (Eq,Show,Read,Data,Typeable)++data CheckOption =+ DefaultCheckOption+ | CascadedCheckOption+ | LocalCheckOption+ deriving (Eq,Show,Read,Data,Typeable)++data AlterDomainAction =+ ADSetDefault ScalarExpr+ | ADDropDefault+ | ADAddConstraint (Maybe [Name]) ScalarExpr+ | ADDropConstraint [Name]+ deriving (Eq,Show,Read,Data,Typeable)+++data AdminOption = WithAdminOption | WithoutAdminOption+ deriving (Eq,Show,Read,Data,Typeable)++data GrantOption = WithGrantOption | WithoutGrantOption+ deriving (Eq,Show,Read,Data,Typeable)++data AdminOptionFor = AdminOptionFor | NoAdminOptionFor+ deriving (Eq,Show,Read,Data,Typeable)++data GrantOptionFor = GrantOptionFor | NoGrantOptionFor+ deriving (Eq,Show,Read,Data,Typeable)++data PrivilegeObject =+ PrivTable [Name]+ | PrivDomain [Name]+ | PrivType [Name]+ | PrivSequence [Name]+ | PrivFunction [Name]+ deriving (Eq,Show,Read,Data,Typeable)++data PrivilegeAction =+ PrivAll+ | PrivSelect [Name]+ | PrivDelete+ | PrivInsert [Name]+ | PrivUpdate [Name]+ | PrivReferences [Name]+ | PrivUsage+ | PrivTrigger+ | PrivExecute+ deriving (Eq,Show,Read,Data,Typeable)++-- | Comment. Useful when generating SQL code programmatically. The+-- parser doesn't produce these.+newtype Comment = BlockComment Text+ deriving (Eq,Show,Read,Data,Typeable)++data MakeSelect+ = MakeSelect+ {msSetQuantifier :: SetQuantifier+ ,msSelectList :: [(ScalarExpr,Maybe Name)]+ ,msFrom :: [TableRef]+ ,msWhere :: Maybe ScalarExpr+ ,msGroupBy :: [GroupingExpr]+ ,msHaving :: Maybe ScalarExpr+ ,msOrderBy :: [SortSpec]+ ,msOffset :: Maybe ScalarExpr+ ,msFetchFirst :: Maybe ScalarExpr+ }++-- | Helper/'default' value for query exprs to make creating query+-- expr values a little easier. It is defined like this:+--+-- > makeSelect :: MakeSelect+-- > makeSelect+-- > = MakeSelect+-- > {msSetQuantifier = SQDefault+-- > ,msSelectList = []+-- > ,msFrom = []+-- > ,msWhere = Nothing+-- > ,msGroupBy = []+-- > ,msHaving = Nothing+-- > ,msOrderBy = []+-- > ,msOffset = Nothing+-- > ,msFetchFirst = Nothing}+-- >+-- > Example, to create a select query expression with a select list 'sl':+-- > toQueryExpr $ makeSelect {msSelectList = sl}++makeSelect :: MakeSelect+makeSelect+ = MakeSelect+ {msSetQuantifier = SQDefault+ ,msSelectList = []+ ,msFrom = []+ ,msWhere = Nothing+ ,msGroupBy = []+ ,msHaving = Nothing+ ,msOrderBy = []+ ,msOffset = Nothing+ ,msFetchFirst = Nothing}++toQueryExpr :: MakeSelect -> QueryExpr+toQueryExpr (MakeSelect q sl f w g h o ff fetch) = Select q sl f w g h o ff fetch
− Language/SQL/SimpleSQL/Syntax.lhs
@@ -1,729 +0,0 @@--> -- | The AST for SQL.-> {-# LANGUAGE DeriveDataTypeable #-}-> module Language.SQL.SimpleSQL.Syntax-> (-- * Scalar expressions-> ScalarExpr(..)-> ,Name(..)-> ,TypeName(..)-> ,IntervalTypeField(..)-> ,Sign(..)-> ,PrecMultiplier(..)-> ,PrecUnits(..)-> ,SetQuantifier(..)-> ,SortSpec(..)-> ,Direction(..)-> ,NullsOrder(..)-> ,InPredValue(..)-> ,SubQueryExprType(..)-> ,CompPredQuantifier(..)-> ,Frame(..)-> ,FrameRows(..)-> ,FramePos(..)-> ,OdbcLiteralType(..)-> -- * Query expressions-> ,QueryExpr(..)-> ,makeSelect-> ,SetOperatorName(..)-> ,Corresponding(..)-> ,Alias(..)-> ,GroupingExpr(..)-> -- ** From-> ,TableRef(..)-> ,JoinType(..)-> ,JoinCondition(..)-> -- * Statements-> ,Statement(..)-> ,DropBehaviour(..)-> ,IdentityRestart(..)-> ,InsertSource(..)-> ,SetClause(..)-> ,TableElement(..)-> ,ColumnDef(..)-> ,DefaultClause(..)-> ,IdentityWhen(..)-> ,SequenceGeneratorOption(..)-> ,ColConstraintDef(..)-> ,ColConstraint(..)-> ,TableConstraint(..)-> ,ReferenceMatch(..)-> ,ReferentialAction(..)-> ,AlterTableAction(..)-> ,CheckOption(..)-> ,AlterDomainAction(..)-> ,AdminOption(..)-> ,GrantOption(..)-> ,PrivilegeObject(..)-> ,PrivilegeAction(..)-> ,AdminOptionFor(..)-> ,GrantOptionFor(..)-> -- * Comment-> ,Comment(..)-> ) where--> import Data.Data--> -- | Represents a value expression. This is used for the expressions-> -- in select lists. It is also used for expressions in where, group-> -- by, having, order by and so on.-> data ScalarExpr-> = -- | a numeric literal optional decimal point, e+--> -- integral exponent, e.g-> ---> -- * 10-> ---> -- * 10.-> ---> -- * .1-> ---> -- * 10.1-> ---> -- * 1e5-> ---> -- * 12.34e-6-> NumLit String-> -- | string literal, with the start and end quote-> -- e.g. 'test' -> StringLit "'" "'" "test"-> | StringLit String String String-> -- | text of interval literal, units of interval precision,-> -- e.g. interval 3 days (3)-> | IntervalLit-> {ilSign :: Maybe Sign -- ^ if + or - used-> ,ilLiteral :: String -- ^ literal text-> ,ilFrom :: IntervalTypeField-> ,ilTo :: Maybe IntervalTypeField-> }--> -- | prefix 'typed literal', e.g. int '42'-> | TypedLit TypeName String--> -- | identifier with parts separated by dots-> | Iden [Name]-> -- | star, as in select *, t.*, count(*)-> | Star--> | Parameter -- ^ Represents a ? in a parameterized query-> | PositionalArg Int -- ^ Represents an e.g. $1 in a parameterized query-> | HostParameter String (Maybe String) -- ^ represents a host-> -- parameter, e.g. :a. The-> -- Maybe String is for the-> -- indicator, e.g. :var-> -- indicator :nl---> -- | Infix binary operators. This is used for symbol operators-> -- (a + b), keyword operators (a and b) and multiple keyword-> -- operators (a is similar to b)-> | BinOp ScalarExpr [Name] ScalarExpr-> -- | Prefix unary operators. This is used for symbol-> -- operators, keyword operators and multiple keyword operators.-> | PrefixOp [Name] ScalarExpr-> -- | Postfix unary operators. This is used for symbol-> -- operators, keyword operators and multiple keyword operators.-> | PostfixOp [Name] ScalarExpr-> -- | Used for ternary, mixfix and other non orthodox-> -- operators. Currently used for row constructors, and for-> -- between.-> | SpecialOp [Name] [ScalarExpr]--> -- | function application (anything that looks like c style-> -- function application syntactically)-> | App [Name] [ScalarExpr]---> -- | aggregate application, which adds distinct or all, and-> -- order by, to regular function application-> | AggregateApp-> {aggName :: [Name] -- ^ aggregate function name-> ,aggDistinct :: SetQuantifier -- ^ distinct-> ,aggArgs :: [ScalarExpr]-- ^ args-> ,aggOrderBy :: [SortSpec] -- ^ order by-> ,aggFilter :: Maybe ScalarExpr -- ^ filter-> }-> -- | aggregates with within group-> | AggregateAppGroup-> {aggName :: [Name] -- ^ aggregate function name-> ,aggArgs :: [ScalarExpr] -- ^ args-> ,aggGroup :: [SortSpec] -- ^ within group-> }-> -- | window application, which adds over (partition by a order-> -- by b) to regular function application. Explicit frames are-> -- not currently supported-> | WindowApp-> {wnName :: [Name] -- ^ window function name-> ,wnArgs :: [ScalarExpr] -- ^ args-> ,wnPartition :: [ScalarExpr] -- ^ partition by-> ,wnOrderBy :: [SortSpec] -- ^ order by-> ,wnFrame :: Maybe Frame -- ^ frame clause-> }--> -- | Used for the operators which look like functions-> -- except the arguments are separated by keywords instead-> -- of commas. The maybe is for the first unnamed argument-> -- if it is present, and the list is for the keyword argument-> -- pairs.-> | SpecialOpK [Name] (Maybe ScalarExpr) [(String,ScalarExpr)]--> -- | cast(a as typename)-> | Cast ScalarExpr TypeName--> -- | case expression. both flavours supported-> | Case-> {caseTest :: Maybe ScalarExpr -- ^ test value-> ,caseWhens :: [([ScalarExpr],ScalarExpr)] -- ^ when branches-> ,caseElse :: Maybe ScalarExpr -- ^ else value-> }--> | Parens ScalarExpr--> -- | in list literal and in subquery, if the bool is false it-> -- means not in was used ('a not in (1,2)')-> | In Bool ScalarExpr InPredValue--> -- | exists, all, any, some subqueries-> | SubQueryExpr SubQueryExprType QueryExpr--> | QuantifiedComparison-> ScalarExpr-> [Name] -- operator-> CompPredQuantifier-> QueryExpr--> | Match ScalarExpr Bool -- true if unique-> QueryExpr-> | Array ScalarExpr [ScalarExpr] -- ^ represents an array-> -- access expression, or an array ctor-> -- e.g. a[3]. The first-> -- scalarExpr is the array, the-> -- second is the subscripts/ctor args-> | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t)--todo: special syntax for like, similar with escape - escape cannot go-in other places--> -- | Escape ScalarExpr Char-> -- | UEscape ScalarExpr Char-> | Collate ScalarExpr [Name]-> | MultisetBinOp ScalarExpr SetOperatorName SetQuantifier ScalarExpr-> | MultisetCtor [ScalarExpr]-> | MultisetQueryCtor QueryExpr-> | NextValueFor [Name]-> | VEComment [Comment] ScalarExpr-> | OdbcLiteral OdbcLiteralType String-> -- ^ an odbc literal e.g. {d '2000-01-01'}-> | OdbcFunc ScalarExpr-> -- ^ an odbc function call e.g. {fn CHARACTER_LENGTH('test')}-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents an identifier name, which can be quoted or unquoted.-> -- examples:-> ---> -- * test -> Name Nothing "test"-> -- * "test" -> Name (Just "\"","\"") "test"-> -- * `something` -> Name (Just ("`","`") "something"-> -- * [ms] -> Name (Just ("[","]") "ms"-> data Name = Name (Maybe (String,String)) String-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents a type name, used in casts.-> data TypeName-> = TypeName [Name]-> | PrecTypeName [Name] Integer-> | PrecScaleTypeName [Name] Integer Integer-> | PrecLengthTypeName [Name] Integer (Maybe PrecMultiplier) (Maybe PrecUnits)-> -- precision, characterset, collate-> | CharTypeName [Name] (Maybe Integer) [Name] [Name]-> | TimeTypeName [Name] (Maybe Integer) Bool -- true == with time zone-> | RowTypeName [(Name,TypeName)]-> | IntervalTypeName IntervalTypeField (Maybe IntervalTypeField)-> | ArrayTypeName TypeName (Maybe Integer)-> | MultisetTypeName TypeName-> deriving (Eq,Show,Read,Data,Typeable)--> data IntervalTypeField = Itf String (Maybe (Integer, Maybe Integer))-> deriving (Eq,Show,Read,Data,Typeable)--> data Sign = Plus | Minus-> deriving (Eq,Show,Read,Data,Typeable)--> data PrecMultiplier = PrecK | PrecM | PrecG | PrecT | PrecP-> deriving (Eq,Show,Read,Data,Typeable)-> data PrecUnits = PrecCharacters-> | PrecOctets-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Used for 'expr in (scalar expression list)', and 'expr in-> -- (subquery)' syntax.-> data InPredValue = InList [ScalarExpr]-> | InQueryExpr QueryExpr-> deriving (Eq,Show,Read,Data,Typeable)--not sure if scalar subquery, exists and unique should be represented like this--> -- | A subquery in a scalar expression.-> data SubQueryExprType-> = -- | exists (query expr)-> SqExists-> -- | unique (query expr)-> | SqUnique-> -- | a scalar subquery-> | SqSq-> deriving (Eq,Show,Read,Data,Typeable)--> data CompPredQuantifier-> = CPAny-> | CPSome-> | CPAll-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents one field in an order by list.-> data SortSpec = SortSpec ScalarExpr Direction NullsOrder-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents 'nulls first' or 'nulls last' in an order by clause.-> data NullsOrder = NullsOrderDefault-> | NullsFirst-> | NullsLast-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents the frame clause of a window-> -- this can be [range | rows] frame_start-> -- or [range | rows] between frame_start and frame_end-> data Frame = FrameFrom FrameRows FramePos-> | FrameBetween FrameRows FramePos FramePos-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents whether a window frame clause is over rows or ranges.-> data FrameRows = FrameRows | FrameRange-> deriving (Eq,Show,Read,Data,Typeable)--> -- | represents the start or end of a frame-> data FramePos = UnboundedPreceding-> | Preceding ScalarExpr-> | Current-> | Following ScalarExpr-> | UnboundedFollowing-> deriving (Eq,Show,Read,Data,Typeable)---> -- | the type of an odbc literal (e.g. {d '2000-01-01'}),-> -- correpsonding to the letter after the opening {-> data OdbcLiteralType = OLDate-> | OLTime-> | OLTimestamp-> deriving (Eq,Show,Read,Data,Typeable)---> -- | Represents a query expression, which can be:-> ---> -- * a regular select;-> ---> -- * a set operator (union, except, intersect);-> ---> -- * a common table expression (with);-> ---> -- * a table value constructor (values (1,2),(3,4)); or-> ---> -- * an explicit table (table t).-> data QueryExpr-> = Select-> {qeSetQuantifier :: SetQuantifier-> ,qeSelectList :: [(ScalarExpr,Maybe Name)]-> -- ^ the expressions and the column aliases--TODO: consider breaking this up. The SQL grammar has-queryexpr = select <select list> [<table expression>]-table expression = <from> [where] [groupby] [having] ...--This would make some things a bit cleaner?--> ,qeFrom :: [TableRef]-> ,qeWhere :: Maybe ScalarExpr-> ,qeGroupBy :: [GroupingExpr]-> ,qeHaving :: Maybe ScalarExpr-> ,qeOrderBy :: [SortSpec]-> ,qeOffset :: Maybe ScalarExpr-> ,qeFetchFirst :: Maybe ScalarExpr-> }-> | QueryExprSetOp-> {qe0 :: QueryExpr-> ,qeCombOp :: SetOperatorName-> ,qeSetQuantifier :: SetQuantifier-> ,qeCorresponding :: Corresponding-> ,qe1 :: QueryExpr-> }-> | With-> {qeWithRecursive :: Bool-> ,qeViews :: [(Alias,QueryExpr)]-> ,qeQueryExpression :: QueryExpr}-> | Values [[ScalarExpr]]-> | Table [Name]-> | QEComment [Comment] QueryExpr-> deriving (Eq,Show,Read,Data,Typeable)--TODO: add queryexpr parens to deal with e.g.-(select 1 union select 2) union select 3-I'm not sure if this is valid syntax or not.--> -- | Helper/'default' value for query exprs to make creating query-> -- expr values a little easier. It is defined like this:-> ---> -- > makeSelect :: QueryExpr-> -- > makeSelect = Select {qeSetQuantifier = SQDefault-> -- > ,qeSelectList = []-> -- > ,qeFrom = []-> -- > ,qeWhere = Nothing-> -- > ,qeGroupBy = []-> -- > ,qeHaving = Nothing-> -- > ,qeOrderBy = []-> -- > ,qeOffset = Nothing-> -- > ,qeFetchFirst = Nothing}--> makeSelect :: QueryExpr-> makeSelect = Select {qeSetQuantifier = SQDefault-> ,qeSelectList = []-> ,qeFrom = []-> ,qeWhere = Nothing-> ,qeGroupBy = []-> ,qeHaving = Nothing-> ,qeOrderBy = []-> ,qeOffset = Nothing-> ,qeFetchFirst = Nothing}--> -- | Represents the Distinct or All keywords, which can be used-> -- before a select list, in an aggregate/window function-> -- application, or in a query expression set operator.-> data SetQuantifier = SQDefault | Distinct | All deriving (Eq,Show,Read,Data,Typeable)--> -- | The direction for a column in order by.-> data Direction = DirDefault | Asc | Desc deriving (Eq,Show,Read,Data,Typeable)-> -- | Query expression set operators.-> data SetOperatorName = Union | Except | Intersect deriving (Eq,Show,Read,Data,Typeable)-> -- | Corresponding, an option for the set operators.-> data Corresponding = Corresponding | Respectively deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents an item in a group by clause.-> data GroupingExpr-> = GroupingParens [GroupingExpr]-> | Cube [GroupingExpr]-> | Rollup [GroupingExpr]-> | GroupingSets [GroupingExpr]-> | SimpleGroup ScalarExpr-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents a entry in the csv of tables in the from clause.-> data TableRef = -- | from t / from s.t-> TRSimple [Name]-> -- | from a join b, the bool is true if natural was used-> | TRJoin TableRef Bool JoinType TableRef (Maybe JoinCondition)-> -- | from (a)-> | TRParens TableRef-> -- | from a as b(c,d)-> | TRAlias TableRef Alias-> -- | from (query expr)-> | TRQueryExpr QueryExpr-> -- | from function(args)-> | TRFunction [Name] [ScalarExpr]-> -- | from lateral t-> | TRLateral TableRef-> -- | ODBC {oj t1 left outer join t2 on expr} syntax-> | TROdbc TableRef-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents an alias for a table valued expression, used in with-> -- queries and in from alias, e.g. select a from t u, select a from t u(b),-> -- with a(c) as select 1, select * from a.-> data Alias = Alias Name (Maybe [Name])-> deriving (Eq,Show,Read,Data,Typeable)--> -- | The type of a join.-> data JoinType = JInner | JLeft | JRight | JFull | JCross-> deriving (Eq,Show,Read,Data,Typeable)--> -- | The join condition.-> data JoinCondition = JoinOn ScalarExpr -- ^ on expr-> | JoinUsing [Name] -- ^ using (column list)-> deriving (Eq,Show,Read,Data,Typeable)-------------------------------> data Statement =-> -- ddl-> CreateSchema [Name]-> | DropSchema [Name] DropBehaviour-> | CreateTable [Name] [TableElement]-> | AlterTable [Name] AlterTableAction-> | DropTable [Name] DropBehaviour-> | CreateView Bool [Name] (Maybe [Name])-> QueryExpr (Maybe CheckOption)-> | DropView [Name] DropBehaviour-> | CreateDomain [Name] TypeName (Maybe ScalarExpr)-> [(Maybe [Name], ScalarExpr)]-> | AlterDomain [Name] AlterDomainAction-> | DropDomain [Name] DropBehaviour--> -- probably won't do character sets, collations-> -- and translations because I think they are too far from-> -- reality-> {- | CreateCharacterSet-> | DropCharacterSet-> | CreateCollation-> | DropCollation-> | CreateTranslation-> | DropTranslation -}-> | CreateAssertion [Name] ScalarExpr-> | DropAssertion [Name] DropBehaviour-> {- | CreateTrigger-> | DropTrigger-> | CreateType-> | AlterType-> | DropType-> -- routine stuff? TODO-> | CreateCast-> | DropCast-> | CreateOrdering-> | DropOrdering -}-> -- transforms-> | CreateSequence [Name] [SequenceGeneratorOption]-> | AlterSequence [Name] [SequenceGeneratorOption]-> | DropSequence [Name] DropBehaviour-> -- dml-> | SelectStatement QueryExpr-> {- | DeclareCursor-> | OpenCursor-> | FetchCursor-> | CloseCursor-> | SelectInto -}-> -- | DeletePositioned-> | Delete [Name] (Maybe Name) (Maybe ScalarExpr)-> | Truncate [Name] IdentityRestart-> | Insert [Name] (Maybe [Name]) InsertSource-> -- | Merge-> | Update [Name] (Maybe Name) [SetClause] (Maybe ScalarExpr)-> {- | TemporaryTable-> | FreeLocator-> | HoldLocator -}-> -- access control-> | GrantPrivilege [PrivilegeAction] PrivilegeObject [Name] GrantOption-> | GrantRole [Name] [Name] AdminOption-> | CreateRole Name-> | DropRole Name-> | RevokePrivilege GrantOptionFor [PrivilegeAction] PrivilegeObject-> [Name] DropBehaviour-> | RevokeRole AdminOptionFor [Name] [Name] DropBehaviour-> -- transaction management-> | StartTransaction-> -- | SetTransaction-> -- | SetContraints-> | Savepoint Name-> | ReleaseSavepoint Name-> | Commit-> | Rollback (Maybe Name)-> -- session-> {- | SetSessionCharacteristics-> | SetSessionAuthorization-> | SetRole-> | SetTimeZone-> | SetCatalog-> | SetSchema-> | SetNames-> | SetTransform-> | SetCollation -}-> | StatementComment [Comment]-> deriving (Eq,Show,Read,Data,Typeable)--> data DropBehaviour =-> Restrict-> | Cascade-> | DefaultDropBehaviour-> deriving (Eq,Show,Read,Data,Typeable)--> data IdentityRestart =-> ContinueIdentity-> | RestartIdentity-> | DefaultIdentityRestart-> deriving (Eq,Show,Read,Data,Typeable)--> data InsertSource =-> InsertQuery QueryExpr-> | DefaultInsertValues-> deriving (Eq,Show,Read,Data,Typeable)--> data SetClause =-> Set [Name] ScalarExpr-> | SetMultiple [[Name]] [ScalarExpr]-> deriving (Eq,Show,Read,Data,Typeable)--> data TableElement =-> TableColumnDef ColumnDef-> | TableConstraintDef (Maybe [Name]) TableConstraint-> deriving (Eq,Show,Read,Data,Typeable)--> data ColumnDef = ColumnDef Name TypeName-> (Maybe DefaultClause)-> [ColConstraintDef]-> -- (Maybe CollateClause)-> deriving (Eq,Show,Read,Data,Typeable)--> data ColConstraintDef =-> ColConstraintDef (Maybe [Name]) ColConstraint-> -- (Maybe [ConstraintCharacteristics])-> deriving (Eq,Show,Read,Data,Typeable)--> data ColConstraint =-> ColNotNullConstraint-> | ColUniqueConstraint-> | ColPrimaryKeyConstraint-> | ColReferencesConstraint [Name] (Maybe Name)-> ReferenceMatch-> ReferentialAction-> ReferentialAction-> | ColCheckConstraint ScalarExpr-> deriving (Eq,Show,Read,Data,Typeable)--> data TableConstraint =-> TableUniqueConstraint [Name]-> | TablePrimaryKeyConstraint [Name]-> | TableReferencesConstraint [Name] [Name] (Maybe [Name])-> ReferenceMatch-> ReferentialAction-> ReferentialAction-> | TableCheckConstraint ScalarExpr-> deriving (Eq,Show,Read,Data,Typeable)---> data ReferenceMatch =-> DefaultReferenceMatch-> | MatchFull-> | MatchPartial-> | MatchSimple-> deriving (Eq,Show,Read,Data,Typeable)--> data ReferentialAction =-> DefaultReferentialAction-> | RefCascade-> | RefSetNull-> | RefSetDefault-> | RefRestrict-> | RefNoAction-> deriving (Eq,Show,Read,Data,Typeable)--> data AlterTableAction =-> AddColumnDef ColumnDef-> | AlterColumnSetDefault Name ScalarExpr-> | AlterColumnDropDefault Name-> | AlterColumnSetNotNull Name-> | AlterColumnDropNotNull Name-> | AlterColumnSetDataType Name TypeName-> {- | AlterColumnAlterIdentity-> | AlterColumnDropIdentity-> | AlterColumnDropColumnGeneration-}-> | DropColumn Name DropBehaviour-> | AddTableConstraintDef (Maybe [Name]) TableConstraint-> -- | AlterTableConstraintDef-> | DropTableConstraintDef [Name] DropBehaviour-> deriving (Eq,Show,Read,Data,Typeable)--> {-data ConstraintCharacteristics =-> ConstraintCharacteristics-> ConstraintCheckTime-> Deferrable-> ConstraintEnforcement-> deriving (Eq,Show,Read,Data,Typeable)--> data ConstraintCheckTime =-> DefaultConstraintCheckTime-> | InitiallyDeferred-> | InitiallyImmeditate-> deriving (Eq,Show,Read,Data,Typeable)--> data Deferrable =-> DefaultDefferable-> | Deferrable-> | NotDeferrable-> deriving (Eq,Show,Read,Data,Typeable)--> data ConstraintEnforcement =-> DefaultConstraintEnforcement-> | Enforced-> | NotEnforced-> deriving (Eq,Show,Read,Data,Typeable) -}--> {-data TableConstraintDef-> deriving (Eq,Show,Read,Data,Typeable) -}--> data DefaultClause =-> DefaultClause ScalarExpr-> | IdentityColumnSpec IdentityWhen [SequenceGeneratorOption]-> | GenerationClause ScalarExpr-> deriving (Eq,Show,Read,Data,Typeable)--> data IdentityWhen =-> GeneratedAlways-> | GeneratedByDefault-> deriving (Eq,Show,Read,Data,Typeable)--> data SequenceGeneratorOption =-> SGODataType TypeName-> | SGOStartWith Integer-> | SGORestart (Maybe Integer)-> | SGOIncrementBy Integer-> | SGOMaxValue Integer-> | SGONoMaxValue-> | SGOMinValue Integer-> | SGONoMinValue-> | SGOCycle-> | SGONoCycle-> deriving (Eq,Show,Read,Data,Typeable)--> data CheckOption =-> DefaultCheckOption-> | CascadedCheckOption-> | LocalCheckOption-> deriving (Eq,Show,Read,Data,Typeable)--> data AlterDomainAction =-> ADSetDefault ScalarExpr-> | ADDropDefault-> | ADAddConstraint (Maybe [Name]) ScalarExpr-> | ADDropConstraint [Name]-> deriving (Eq,Show,Read,Data,Typeable)---> data AdminOption = WithAdminOption | WithoutAdminOption-> deriving (Eq,Show,Read,Data,Typeable)--> data GrantOption = WithGrantOption | WithoutGrantOption-> deriving (Eq,Show,Read,Data,Typeable)--> data AdminOptionFor = AdminOptionFor | NoAdminOptionFor-> deriving (Eq,Show,Read,Data,Typeable)--> data GrantOptionFor = GrantOptionFor | NoGrantOptionFor-> deriving (Eq,Show,Read,Data,Typeable)--> data PrivilegeObject =-> PrivTable [Name]-> | PrivDomain [Name]-> | PrivType [Name]-> | PrivSequence [Name]-> | PrivFunction [Name]-> deriving (Eq,Show,Read,Data,Typeable)--> data PrivilegeAction =-> PrivAll-> | PrivSelect [Name]-> | PrivDelete-> | PrivInsert [Name]-> | PrivUpdate [Name]-> | PrivReferences [Name]-> | PrivUsage-> | PrivTrigger-> | PrivExecute-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Comment. Useful when generating SQL code programmatically. The-> -- parser doesn't produce these.-> data Comment = BlockComment String-> deriving (Eq,Show,Read,Data,Typeable)-
README view
@@ -1,5 +1,5 @@-A parser for SQL queries in Haskell.+A parser for SQL in Haskell. Homepage: http://jakewheat.github.io/simple-sql-parser/latest -Contact: jakewheatmail@gmail.com+Contact: jakewheat@tutanota.com
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
changelog view
@@ -1,3 +1,19 @@+0.7.0+ support autoincrement for sqlite+ support table constraints without separating comma for sqlite+ switch source from literate to regular haskell+ use prettyprinter lib instead of pretty+ parsing nested block comments regressed - post a bug if you need this+ fixed fixity parsing of union, except and intersect (matches postgres docs now)+ removed the Errors module - the pretty printer function for errors is in the Parse module+ parses from and pretty prints to strict Text+ use strict Text instead of String everywhere+ tested with latest three main ghc releases (9.8.1, 9.6.4, and 9.4.8) and stack lts 22.5+ the makeSelect helper is now a distinct type, code using it will need some trivial+ tweaks, this is change so that code using makeSelect doesn't emit warnings+ overhaul website+0.6.1 added odbc handling to sqlsqerver dialect+ added sqlserver dialect case for convert function 0.6.0 tested with ghc 8.8.1 also change the dialect handling - now a dialect is a bunch of flags
+ examples/SimpleSQLParserTool.hs view
@@ -0,0 +1,105 @@++{-+Simple command line tool to experiment with simple-sql-parser++Commands:++parse: parse sql from file, stdin or from command line+lex: lex sql same+indent: parse then pretty print sql++TODO: this is supposed to be a simple example, but it's a total mess+write some simple helpers so it's all in text?++-}++{-# LANGUAGE TupleSections #-}+import System.Environment (getArgs)+import Control.Monad (forM_, when)+import Data.Maybe (isJust)+import System.Exit (exitFailure)+import Data.List (intercalate)+import Text.Show.Pretty (ppShow)+--import Control.Applicative++import qualified Data.Text as T++import Language.SQL.SimpleSQL.Pretty+ (prettyStatements)+import Language.SQL.SimpleSQL.Parse+ (parseStatements+ ,prettyError)+import qualified Language.SQL.SimpleSQL.Lex as L+import Language.SQL.SimpleSQL.Dialect (ansi2011)+++main :: IO ()+main = do+ args <- getArgs+ case args of+ [] -> do+ showHelp $ Just "no command given"+ (c:as) -> do+ let cmd = lookup c commands+ maybe (showHelp (Just "command not recognised"))+ (\(_,cmd') -> cmd' as)+ cmd++commands :: [(String, (String,[String] -> IO ()))]+commands =+ [("help", helpCommand)+ ,("parse", parseCommand)+ ,("lex", lexCommand)+ ,("format", formatCommand)]++showHelp :: Maybe String -> IO ()+showHelp msg = do+ maybe (return ()) (\e -> putStrLn $ "Error: " ++ e) msg+ putStrLn "Usage:\n SimpleSQLParserTool command args"+ forM_ commands $ \(c, (h,_)) -> do+ putStrLn $ c ++ "\t" ++ h+ when (isJust msg) $ exitFailure++helpCommand :: (String,[String] -> IO ())+helpCommand =+ ("show help for this progam", \_ -> showHelp Nothing)++getInput :: [String] -> IO (FilePath,String)+getInput as =+ case as of+ ["-"] -> ("",) <$> getContents+ ("-c":as') -> return ("", unwords as')+ [filename] -> (filename,) <$> readFile filename+ _ -> showHelp (Just "arguments not recognised") >> error ""++parseCommand :: (String,[String] -> IO ())+parseCommand =+ ("parse SQL from file/stdin/command line (use -c to parse from command line)"+ ,\args -> do+ (f,src) <- getInput args+ either (error . T.unpack . prettyError)+ (putStrLn . ppShow)+ $ parseStatements ansi2011 (T.pack f) Nothing (T.pack src)+ )++lexCommand :: (String,[String] -> IO ())+lexCommand =+ ("lex SQL from file/stdin/command line (use -c to parse from command line)"+ ,\args -> do+ (f,src) <- getInput args+ either (error . T.unpack . L.prettyError)+ (putStrLn . intercalate ",\n" . map show)+ $ L.lexSQL ansi2011 (T.pack f) Nothing (T.pack src)+ )+++formatCommand :: (String,[String] -> IO ())+formatCommand =+ ("parse then pretty print SQL from file/stdin/command line (use -c to parse from command line)"+ ,\args -> do+ (f,src) <- getInput args+ either (error . T.unpack . prettyError)+ (putStrLn . T.unpack . prettyStatements ansi2011)+ $ parseStatements ansi2011 (T.pack f) Nothing (T.pack src)++ )
simple-sql-parser.cabal view
@@ -1,5 +1,7 @@+cabal-version: 2.2+ name: simple-sql-parser-version: 0.6.0+version: 0.7.0 synopsis: A parser for SQL. description:@@ -11,15 +13,14 @@ <http://jakewheat.github.io/simple-sql-parser/latest>. homepage: http://jakewheat.github.io/simple-sql-parser/latest-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Jake Wheat-maintainer: jakewheatmail@gmail.com-copyright: Copyright Jake Wheat 2013, 2014, 2015+maintainer: jakewheat@tutanota.com+copyright: Copyright 2013 - 2024, Jake Wheat and the simple-sql-parser contributors. category: Database,Language build-type: Simple-extra-source-files: README,LICENSE,changelog-cabal-version: >=1.10+extra-doc-files: README,LICENSE,changelog bug-reports: https://github.com/JakeWheat/simple-sql-parser/issues source-repository head@@ -27,50 +28,40 @@ location: https://github.com/JakeWheat/simple-sql-parser.git Flag parserexe- Description: Build SimpleSqlParserTool exe+ Description: Build SimpleSQLParserTool exe Default: False -Flag fixitytest- Description: Build fixity test exe- Default: False+common shared-properties+ default-language: Haskell2010+ build-depends: base >=4 && <5,+ megaparsec >=9.6 && <9.7, + parser-combinators >= 1.3 && < 1.4,+ mtl >=2.1 && <2.4,+ prettyprinter >= 1.7 && < 1.8,+ text >= 2.0 && < 2.2,+ containers >= 0.6 && < 0.8++ ghc-options: -Wall+ library+ import: shared-properties exposed-modules: Language.SQL.SimpleSQL.Pretty, Language.SQL.SimpleSQL.Parse, Language.SQL.SimpleSQL.Lex, Language.SQL.SimpleSQL.Syntax, Language.SQL.SimpleSQL.Dialect- Other-Modules: Language.SQL.SimpleSQL.Errors,- Language.SQL.SimpleSQL.Combinators- build-depends: base >=4 && <5,- parsec >=3.1 && <3.2,- mtl >=2.1 && <2.3,- pretty >= 1.1 && < 1.2- -- hs-source-dirs:- default-language: Haskell2010- ghc-options: -Wall- other-extensions: TupleSections,DeriveDataTypeable Test-Suite Tests+ import: shared-properties type: exitcode-stdio-1.0- main-is: RunTests.lhs- hs-source-dirs: .,tools- Build-Depends: base >=4 && <5,- parsec >=3.1 && <3.2,- mtl >=2.1 && <2.3,- pretty >= 1.1 && < 1.2,- tasty >= 1.1 && < 1.3,+ main-is: RunTests.hs+ hs-source-dirs: tests+ Build-Depends: simple-sql-parser,+ tasty >= 1.1 && < 1.6, tasty-hunit >= 0.9 && < 0.11 - Other-Modules: Language.SQL.SimpleSQL.Pretty,- Language.SQL.SimpleSQL.Parse,- Language.SQL.SimpleSQL.Lex,- Language.SQL.SimpleSQL.Syntax,- Language.SQL.SimpleSQL.Errors,- Language.SQL.SimpleSQL.Combinators,- Language.SQL.SimpleSQL.Dialect-- Language.SQL.SimpleSQL.ErrorMessages,+ Other-Modules: Language.SQL.SimpleSQL.ErrorMessages, Language.SQL.SimpleSQL.FullQueries, Language.SQL.SimpleSQL.GroupBy, Language.SQL.SimpleSQL.MySQL,@@ -90,52 +81,19 @@ Language.SQL.SimpleSQL.Tpch, Language.SQL.SimpleSQL.ScalarExprs, Language.SQL.SimpleSQL.LexerTests,- Language.SQL.SimpleSQL.CustomDialect-- other-extensions: TupleSections,DeriveDataTypeable- default-language: Haskell2010- ghc-options: -Wall -threaded+ Language.SQL.SimpleSQL.CustomDialect,+ Language.SQL.SimpleSQL.EmptyStatement,+ Language.SQL.SimpleSQL.CreateIndex+ + ghc-options: -threaded -executable SimpleSqlParserTool- main-is: SimpleSqlParserTool.lhs- hs-source-dirs: .,tools- Build-Depends: base >=4 && <5,- parsec >=3.1 && <3.2,- mtl >=2.1 && <2.3,- pretty >= 1.1 && < 1.2,+executable SimpleSQLParserTool+ import: shared-properties+ main-is: SimpleSQLParserTool.hs+ hs-source-dirs: examples+ Build-Depends: simple-sql-parser, pretty-show >= 1.6 && < 1.10- other-extensions: TupleSections,DeriveDataTypeable- default-language: Haskell2010- ghc-options: -Wall- Other-Modules: Language.SQL.SimpleSQL.Combinators- Language.SQL.SimpleSQL.Dialect- Language.SQL.SimpleSQL.Errors- Language.SQL.SimpleSQL.Lex- Language.SQL.SimpleSQL.Parse- Language.SQL.SimpleSQL.Pretty- Language.SQL.SimpleSQL.Syntax- if flag(parserexe) buildable: True else buildable: False--executable Fixity- main-is: Fixity.lhs- hs-source-dirs: .,tools- Build-Depends: base >=4 && <5,- parsec >=3.1 && <3.2,- mtl >=2.1 && <2.3,- pretty >= 1.1 && < 1.2,- pretty-show >= 1.6 && < 1.10,- tasty >= 1.1 && < 1.3,- tasty-hunit >= 0.9 && < 0.11-- other-extensions: TupleSections,DeriveDataTypeable- default-language: Haskell2010- ghc-options: -Wall- if flag(fixitytest)- buildable: True- else- buildable: False-
+ tests/Language/SQL/SimpleSQL/CreateIndex.hs view
@@ -0,0 +1,18 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.CreateIndex where++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestTypes++createIndexTests :: TestItem+createIndexTests = Group "create index tests"+ [TestStatement ansi2011 "create index a on tbl(c1)"+ $ CreateIndex False [nm "a"] [nm "tbl"] [nm "c1"]+ ,TestStatement ansi2011 "create index a.b on sc.tbl (c1, c2)"+ $ CreateIndex False [nm "a", nm "b"] [nm "sc", nm "tbl"] [nm "c1", nm "c2"]+ ,TestStatement ansi2011 "create unique index a on tbl(c1)"+ $ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]+ ]+ where+ nm = Name Nothing
+ tests/Language/SQL/SimpleSQL/CustomDialect.hs view
@@ -0,0 +1,28 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where++import Language.SQL.SimpleSQL.TestTypes++customDialectTests :: TestItem+customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests+ ++ map (uncurry ParseScalarExprFails) failTests )+ where+ failTests = [(ansi2011,"SELECT DATE('2000-01-01')")+ ,(ansi2011,"SELECT DATE")+ ,(dateApp,"SELECT DATE")+ ,(dateIden,"SELECT DATE('2000-01-01')")+ -- show this never being allowed as an alias+ ,(ansi2011,"SELECT a date")+ ,(dateApp,"SELECT a date")+ ,(dateIden,"SELECT a date")+ ]+ passTests = [(ansi2011,"SELECT a b")+ ,(noDateKeyword,"SELECT DATE('2000-01-01')")+ ,(noDateKeyword,"SELECT DATE")+ ,(dateApp,"SELECT DATE('2000-01-01')")+ ,(dateIden,"SELECT DATE")+ ]+ noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}+ dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}+ dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}
+ tests/Language/SQL/SimpleSQL/EmptyStatement.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.EmptyStatement where++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestTypes++emptyStatementTests :: TestItem+emptyStatementTests = Group "empty statement"+ [ TestStatement ansi2011 ";" EmptyStatement+ , TestStatements ansi2011 ";" [EmptyStatement]+ , TestStatements ansi2011 ";;" [EmptyStatement, EmptyStatement]+ , TestStatements ansi2011 ";;;" [EmptyStatement, EmptyStatement, EmptyStatement]+ , TestStatement ansi2011 "/* comment */ ;" EmptyStatement+ , TestStatements ansi2011 "" []+ , TestStatements ansi2011 "/* comment */" []+ , TestStatements ansi2011 "/* comment */ ;" [EmptyStatement]+ , TestStatements ansi2011 "/* comment */ ; /* comment */ ;"+ [EmptyStatement, EmptyStatement]+ , TestStatements ansi2011 "/* comment */ ; /* comment */ ; /* comment */ ;"+ [EmptyStatement, EmptyStatement, EmptyStatement]+ ]
+ tests/Language/SQL/SimpleSQL/ErrorMessages.hs view
@@ -0,0 +1,156 @@++{-+Want to work on the error messages. Ultimately, parsec won't give the+best error message for a parser combinator library in haskell. Should+check out the alternatives such as polyparse and uu-parsing.++For now the plan is to try to get the best out of parsec. Skip heavy+work on this until the parser is more left factored?++Ideas:++1. generate large lists of invalid syntax+2. create table of the sql source and the error message+3. save these tables and compare from version to version. Want to+ catch improvements and regressions and investigate. Have to do this+ manually++= generating bad sql source++take good sql statements or expressions. Convert them into sequences+of tokens - want to preserve the whitespace and comments perfectly+here. Then modify these lists by either adding a token, removing a+token, or modifying a token (including creating bad tokens of raw+strings which don't represent anything than can be tokenized.++Now can see the error message for all of these bad strings. Probably+have to generate and prune this list manually in stages since there+will be too many.++Contexts:++another area to focus on is contexts: for instance, we have a set of+e.g. 1000 bad scalar expressions with error messages. Now can put+those bad scalar expressions into various contexts and see that the+error messages are still good.++plan:++1. create a list of all the value expression, with some variations for+ each+2. manually create some error variations for each expression+3. create a renderer which will create a csv of the expressions and+ the errors+ this is to load as a spreadsheet to investigate more+4. create a renderer for the csv which will create a markdown file for+ the website. this is to demonstrate the error messages in the+ documentation++Then create some contexts for all of these: inside another value+expression, or inside a query expression. Do the same: render and+review the error messages.++Then, create some query expressions to focus on the non value+expression parts.+-}+++module Language.SQL.SimpleSQL.ErrorMessages where++{-import Language.SQL.SimpleSQL.Parser+import Data.List+import Text.Groom++valueExpressions :: [String]+valueExpressions =+ ["10.."+ ,"..10"+ ,"10e1e2"+ ,"10e--3"+ ,"1a"+ ,"1%"++ ,"'b'ad'"+ ,"'bad"+ ,"bad'"++ ,"interval '5' ay"+ ,"interval '5' day (4.4)"+ ,"interval '5' day (a)"+ ,"intervala '5' day"+ ,"interval 'x' day (3"+ ,"interval 'x' day 3)"++ ,"1badiden"+ ,"$"+ ,"!"+ ,"*.a"++ ,"??"+ ,"3?"+ ,"?a"++ ,"row"+ ,"row 1,2"+ ,"row(1,2"+ ,"row 1,2)"+ ,"row(1 2)"++ ,"f("+ ,"f)"++ ,"f(a"+ ,"f a)"+ ,"f(a b)"++{-+TODO:+case+operators+-}++ ,"a + (b + c"++{-+casts+subqueries: + whole set of parentheses use+in list+'keyword' functions+aggregates+window functions+-}+++ ]++queryExpressions :: [String]+queryExpressions =+ map sl1 valueExpressions+ ++ map sl2 valueExpressions+ ++ map sl3 valueExpressions+ +++ ["select a from t inner jin u"]+ where+ sl1 x = "select " ++ x ++ " from t"+ sl2 x = "select " ++ x ++ ", y from t"+ sl3 x = "select " ++ x ++ " fom t"++valExprs :: [String] -> [(String,String)]+valExprs = map parseOne+ where+ parseOne x = let p = parseValueExpr "" Nothing x+ in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)+++queryExprs :: [String] -> [(String,String)]+queryExprs = map parseOne+ where+ parseOne x = let p = parseQueryExpr "" Nothing x+ in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)+++pExprs :: [String] -> [String] -> String+pExprs x y =+ let l = valExprs x ++ queryExprs y+ in intercalate "\n\n\n\n" $ map (\(a,b) -> a ++ "\n" ++ b) l+-}
+ tests/Language/SQL/SimpleSQL/FullQueries.hs view
@@ -0,0 +1,40 @@++-- Some tests for parsing full queries.++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+++fullQueriesTests :: TestItem+fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))+ [("select count(*) from t"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(App [Name Nothing "count"] [Star], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }+ )++ ,("select a, sum(c+d) as s\n\+ \ from t,u\n\+ \ where a > 5\n\+ \ group by a\n\+ \ having count(1) > 5\n\+ \ order by s"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "a"], Nothing)+ ,(App [Name Nothing "sum"]+ [BinOp (Iden [Name Nothing "c"])+ [Name Nothing "+"] (Iden [Name Nothing "d"])]+ ,Just $ Name Nothing "s")]+ ,msFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]+ ,msWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")+ ,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+ ,msHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"])+ [Name Nothing ">"] (NumLit "5")+ ,msOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault]+ }+ )+ ]
+ tests/Language/SQL/SimpleSQL/GroupBy.hs view
@@ -0,0 +1,238 @@++-- Here are the tests for the group by component of query exprs++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.GroupBy (groupByTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+++groupByTests :: TestItem+groupByTests = Group "groupByTests"+ [simpleGroupBy+ ,newGroupBy+ ,randomGroupBy+ ]++simpleGroupBy :: TestItem+simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a,sum(b) from t group by a"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)+ ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+ })++ ,("select a,b,sum(c) from t group by a,b"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)+ ,(Iden [Name Nothing "b"],Nothing)+ ,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]+ ,SimpleGroup $ Iden [Name Nothing "b"]]+ })+ ]++{-+test the new group by (), grouping sets, cube and rollup syntax (not+sure which sql version they were introduced, 1999 or 2003 I think).+-}++newGroupBy :: TestItem+newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))+ [("select * from t group by ()", ms [GroupingParens []])+ ,("select * from t group by grouping sets ((), (a))"+ ,ms [GroupingSets [GroupingParens []+ ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]])+ ,("select * from t group by cube(a,b)"+ ,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])+ ,("select * from t group by rollup(a,b)"+ ,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])+ ]+ where+ ms g = toQueryExpr $ makeSelect {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = g}++randomGroupBy :: TestItem+randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)+ ["select * from t GROUP BY a"+ ,"select * from t GROUP BY GROUPING SETS((a))"+ ,"select * from t GROUP BY a,b,c"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c))"+ ,"select * from t GROUP BY ROLLUP(a,b)"+ ,"select * from t GROUP BY GROUPING SETS((a,b),\n\+ \(a),\n\+ \() )"+ ,"select * from t GROUP BY ROLLUP(b,a)"+ ,"select * from t GROUP BY GROUPING SETS((b,a),\n\+ \(b),\n\+ \() )"+ ,"select * from t GROUP BY CUBE(a,b,c)"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\+ \(a,b),\n\+ \(a,c),\n\+ \(b,c),\n\+ \(a),\n\+ \(b),\n\+ \(c),\n\+ \() )"+ ,"select * from t GROUP BY ROLLUP(Province, County, City)"+ ,"select * from t GROUP BY ROLLUP(Province, (County, City))"+ ,"select * from t GROUP BY ROLLUP(Province, (County, City))"+ ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\+ \(Province),\n\+ \() )"+ ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\+ \(Province, County),\n\+ \(Province),\n\+ \() )"+ ,"select * from t GROUP BY a, ROLLUP(b,c)"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\+ \(a,b),\n\+ \(a) )"+ ,"select * from t GROUP BY a, b, ROLLUP(c,d)"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\+ \(a,b,c),\n\+ \(a,b) )"+ ,"select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\+ \(a,b),\n\+ \(a),\n\+ \(b,c),\n\+ \(b),\n\+ \() )"+ ,"select * from t GROUP BY ROLLUP(a), CUBE(b,c)"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\+ \(a,b),\n\+ \(a,c),\n\+ \(a),\n\+ \(b,c),\n\+ \(b),\n\+ \(c),\n\+ \() )"+ ,"select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"+ ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\+ \(a,b,c),\n\+ \(a,b),\n\+ \(a,c,d),\n\+ \(a,c),\n\+ \(a),\n\+ \(b,c,d),\n\+ \(b,c),\n\+ \(b),\n\+ \(c,d),\n\+ \(c),\n\+ \() )"+ ,"select * from t GROUP BY a, ROLLUP(a,b)"+ ,"select * from t GROUP BY GROUPING SETS((a,b),\n\+ \(a) )"+ ,"select * from t GROUP BY Region,\n\+ \ROLLUP(Sales_Person, WEEK(Sales_Date)),\n\+ \CUBE(YEAR(Sales_Date), MONTH (Sales_Date))"+ ,"select * from t GROUP BY ROLLUP (Region, Sales_Person, WEEK(Sales_Date),\n\+ \YEAR(Sales_Date), MONTH(Sales_Date) )"++ ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \WHERE WEEK(SALES_DATE) = 13\n\+ \GROUP BY WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON\n\+ \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"++ ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \WHERE WEEK(SALES_DATE) = 13\n\+ \GROUP BY GROUPING SETS ( (WEEK(SALES_DATE), SALES_PERSON),\n\+ \(DAYOFWEEK(SALES_DATE), SALES_PERSON))\n\+ \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"++ ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \WHERE WEEK(SALES_DATE) = 13\n\+ \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\+ \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"++ ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \WHERE WEEK(SALES_DATE) = 13\n\+ \GROUP BY CUBE ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\+ \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"++ ,"SELECT SALES_PERSON,\n\+ \MONTH(SALES_DATE) AS MONTH,\n\+ \SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \GROUP BY GROUPING SETS ( (SALES_PERSON, MONTH(SALES_DATE)),\n\+ \()\n\+ \)\n\+ \ORDER BY SALES_PERSON, MONTH"++ ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) )\n\+ \ORDER BY WEEK, DAY_WEEK"++ ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\+ \REGION,\n\+ \SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \GROUP BY ROLLUP ( MONTH(SALES_DATE), REGION )\n\+ \ORDER BY MONTH, REGION"++ ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \MONTH(SALES_DATE) AS MONTH,\n\+ \REGION,\n\+ \SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES\n\+ \GROUP BY GROUPING SETS ( ROLLUP( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) ),\n\+ \ROLLUP( MONTH(SALES_DATE), REGION ) )\n\+ \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"++ ,"SELECT R1, R2,\n\+ \WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \MONTH(SALES_DATE) AS MONTH,\n\+ \REGION, SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\+ \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\+ \DAYOFWEEK(SALES_DATE))),\n\+ \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\+ \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"++ {-,"SELECT COALESCE(R1,R2) AS GROUP,\n\+ \WEEK(SALES_DATE) AS WEEK,\n\+ \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\+ \MONTH(SALES_DATE) AS MONTH,\n\+ \REGION, SUM(SALES) AS UNITS_SOLD\n\+ \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\+ \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\+ \DAYOFWEEK(SALES_DATE))),\n\+ \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\+ \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-}+ -- as group - needs more subtle keyword blacklisting++ -- decimal as a function not allowed due to the reserved keyword+ -- handling: todo, review if this is ansi standard function or+ -- if there are places where reserved keywords can still be used+ ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\+ \REGION,\n\+ \SUM(SALES) AS UNITS_SOLD,\n\+ \MAX(SALES) AS BEST_SALE,\n\+ \CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\+ \FROM SALES\n\+ \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\+ \ORDER BY MONTH, REGION"++ ]
+ tests/Language/SQL/SimpleSQL/LexerTests.hs view
@@ -0,0 +1,398 @@+++-- Test for the lexer+++{-+TODO:+figure out a way to do quickcheck testing:+1. generate valid tokens and check they parse++2. combine two generated tokens together for the combo testing++this especially will work much better for the postgresql extensible+operator tests which doing exhaustively takes ages and doesn't bring+much benefit over testing a few using quickcheck.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.LexerTests (lexerTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Lex+ (Token(..)+ ,tokenListWillPrintAndLex+ )++import qualified Data.Text as T+import Data.Text (Text)+ +--import Debug.Trace+--import Data.Char (isAlpha)+-- import Data.List++lexerTests :: TestItem+lexerTests = Group "lexerTests" $+ [bootstrapTests+ ,ansiLexerTests+ ,postgresLexerTests+ ,sqlServerLexerTests+ ,oracleLexerTests+ ,mySqlLexerTests+ ,odbcLexerTests]++-- quick sanity tests to see something working+bootstrapTests :: TestItem+bootstrapTests = Group "bootstrap tests" [Group "bootstrap tests" $+ map (uncurry (LexTest ansi2011)) (+ [("iden", [Identifier Nothing "iden"])+ ,("'string'", [SqlString "'" "'" "string"])++ ,(" ", [Whitespace " "])+ ,("\t ", [Whitespace "\t "])+ ,(" \n ", [Whitespace " \n "])++ ,("--", [LineComment "--"])+ ,("--\n", [LineComment "--\n"])+ ,("--stuff", [LineComment "--stuff"])+ ,("-- stuff", [LineComment "-- stuff"])+ ,("-- stuff\n", [LineComment "-- stuff\n"])+ ,("--\nstuff", [LineComment "--\n", Identifier Nothing "stuff"])+ ,("-- com \nstuff", [LineComment "-- com \n", Identifier Nothing "stuff"])++ ,("/*test1*/", [BlockComment "/*test1*/"])+ ,("/**/", [BlockComment "/**/"])+ ,("/***/", [BlockComment "/***/"])+ ,("/* * */", [BlockComment "/* * */"])+ ,("/*test*/", [BlockComment "/*test*/"])+ ,("/*te/*st*/", [BlockComment "/*te/*st*/"])+ ,("/*te*st*/", [BlockComment "/*te*st*/"])+ ,("/*lines\nmore lines*/", [BlockComment "/*lines\nmore lines*/"])+ ,("/*test1*/\n", [BlockComment "/*test1*/", Whitespace "\n"])+ ,("/*test1*/stuff", [BlockComment "/*test1*/", Identifier Nothing "stuff"])++ ,("1", [SqlNumber "1"])+ ,("42", [SqlNumber "42"])++ -- have to fix the dialect handling in the tests+ --,("$1", [PositionalArg 1])+ --,("$200", [PositionalArg 200])++ ,(":test", [PrefixedVariable ':' "test"])++ ] ++ map (\a -> (a, [Symbol a])) (+ ["!=", "<>", ">=", "<=", "||"]+ ++ map T.singleton ("(),-+*/<>=." :: [Char])))]+++ansiLexerTable :: [(Text,[Token])]+ansiLexerTable =+ -- single char symbols+ map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;()"+ -- multi char symbols+ ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"]+ ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]+ -- simple identifiers+ in map (\i -> (i, [Identifier Nothing i])) idens+ <> map (\i -> ("\"" <> i <> "\"", [Identifier (Just ("\"","\"")) i])) idens+ -- todo: in order to make lex . pretty id, need to+ -- preserve the case of the u+ <> map (\i -> ("u&\"" <> i <> "\"", [Identifier (Just ("u&\"","\"")) i])) idens+ -- host param+ <> map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens+ )+ -- quoted identifiers with embedded double quotes+ -- the lexer doesn't unescape the quotes+ ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]+ -- strings+ -- the lexer doesn't apply escapes at all+ ++ [("'string'", [SqlString "'" "'" "string"])+ ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])+ ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])+ ,("'\n'", [SqlString "'" "'" "\n"])]+ -- csstrings+ ++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))+ ["n", "N","b", "B","x", "X", "u&"]+ -- numbers+ ++ [("10", [SqlNumber "10"])+ ,(".1", [SqlNumber ".1"])+ ,("5e3", [SqlNumber "5e3"])+ ,("5e+3", [SqlNumber "5e+3"])+ ,("5e-3", [SqlNumber "5e-3"])+ ,("10.2", [SqlNumber "10.2"])+ ,("10.2e7", [SqlNumber "10.2e7"])]+ -- whitespace+ ++ concat [[(T.singleton a,[Whitespace $ T.singleton a])+ ,(T.singleton a <> T.singleton b, [Whitespace (T.singleton a <> T.singleton b)])]+ | a <- " \n\t", b <- " \n\t"]+ -- line comment+ ++ map (\c -> (c, [LineComment c]))+ ["--", "-- ", "-- this is a comment", "-- line com\n"]+ -- block comment+ ++ map (\c -> (c, [BlockComment c]))+ ["/**/", "/* */","/* this is a comment */"+ ,"/* this *is/ a comment */"+ ]+++ansiLexerTests :: TestItem+ansiLexerTests = Group "ansiLexerTests" $+ [Group "ansi lexer token tests" $ [LexTest ansi2011 s t | (s,t) <- ansiLexerTable]+ ,Group "ansi generated combination lexer tests" $+ [ LexTest ansi2011 (s <> s1) (t <> t1)+ | (s,t) <- ansiLexerTable+ , (s1,t1) <- ansiLexerTable+ , tokenListWillPrintAndLex ansi2011 $ t <> t1++ ]+ ,Group "ansiadhoclexertests" $+ map (uncurry $ LexTest ansi2011)+ [("", [])+ ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"])+ ] +++ [-- want to make sure this gives a parse error+ LexFails ansi2011 "*/"+ -- combinations of pipes: make sure they fail because they could be+ -- ambiguous and it is really unclear when they are or not, and+ -- what the result is even when they are not ambiguous+ ,LexFails ansi2011 "|||"+ ,LexFails ansi2011 "||||"+ ,LexFails ansi2011 "|||||"+ -- another user experience thing: make sure extra trailing+ -- number chars are rejected rather than attempting to parse+ -- if the user means to write something that is rejected by this code,+ -- then they can use whitespace to make it clear and then it will parse+ ,LexFails ansi2011 "12e3e4"+ ,LexFails ansi2011 "12e3e4"+ ,LexFails ansi2011 "12e3e4"+ ,LexFails ansi2011 "12e3.4"+ ,LexFails ansi2011 "12.4.5"+ ,LexFails ansi2011 "12.4e5.6"+ ,LexFails ansi2011 "12.4e5e7"]+ ]++{-+todo: lexing tests+do quickcheck testing:+can try to generate valid tokens then check they parse++same as above: can also try to pair tokens, create an accurate+ function to say which ones can appear adjacent, and test++I think this plus the explicit lists of tokens like above which do+basic sanity + explicit edge casts will provide a high level of+assurance.+-}++++postgresLexerTable :: [(Text,[Token])]+postgresLexerTable =+ -- single char symbols+ map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;():"+ -- multi char symbols+ ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]+ -- generic symbols++ ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]+ -- simple identifiers+ in map (\i -> (i, [Identifier Nothing i])) idens+ ++ map (\i -> ("\"" <> i <> "\"", [Identifier (Just ("\"","\"")) i])) idens+ -- todo: in order to make lex . pretty id, need to+ -- preserve the case of the u+ ++ map (\i -> ("u&\"" <> i <> "\"", [Identifier (Just ("u&\"","\"")) i])) idens+ -- host param+ ++ map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens+ )+ -- positional var+ ++ [("$1", [PositionalArg 1])]+ -- quoted identifiers with embedded double quotes+ ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]+ -- strings+ ++ [("'string'", [SqlString "'" "'" "string"])+ ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])+ ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])+ ,("'\n'", [SqlString "'" "'" "\n"])+ ,("E'\n'", [SqlString "E'" "'" "\n"])+ ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])+ ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])+ ,("'not this \\' quote", [SqlString "'" "'" "not this \\"+ ,Whitespace " "+ ,Identifier Nothing "quote"])+ ,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])+ ,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])+ ,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])+ ]+ -- csstrings+ ++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))+ ["n", "N","b", "B","x", "X", "u&", "e", "E"]+ -- numbers+ ++ [("10", [SqlNumber "10"])+ ,(".1", [SqlNumber ".1"])+ ,("5e3", [SqlNumber "5e3"])+ ,("5e+3", [SqlNumber "5e+3"])+ ,("5e-3", [SqlNumber "5e-3"])+ ,("10.2", [SqlNumber "10.2"])+ ,("10.2e7", [SqlNumber "10.2e7"])]+ -- whitespace+ ++ concat [[(T.singleton a,[Whitespace $ T.singleton a])+ ,(T.singleton a <> T.singleton b, [Whitespace $ T.singleton a <> T.singleton b])]+ | a <- " \n\t", b <- " \n\t"]+ -- line comment+ ++ map (\c -> (c, [LineComment c]))+ ["--", "-- ", "-- this is a comment", "-- line com\n"]+ -- block comment+ ++ map (\c -> (c, [BlockComment c]))+ ["/**/", "/* */","/* this is a comment */"+ ,"/* this *is/ a comment */"+ ]++{-+An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:+++ - * / < > = ~ ! @ # % ^ & | ` ?++There are a few restrictions on operator names, however:+-- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.++A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:++~ ! @ # % ^ & | ` ?++todo: 'negative' tests+symbol then --+symbol then /*+operators without one of the exception chars+ followed by + or - without whitespace++also: do the testing for the ansi compatibility special cases+-}++postgresShortOperatorTable :: [(Text,[Token])]+postgresShortOperatorTable =+ [ (x, [Symbol x]) | x <- someValidPostgresOperators 2]+++postgresExtraOperatorTable :: [(Text,[Token])]+postgresExtraOperatorTable =+ [ (x, [Symbol x]) | x <- someValidPostgresOperators 4]+++someValidPostgresOperators :: Int -> [Text]+someValidPostgresOperators l =+ [ x+ | n <- [1..l]+ , x <- combos "+-*/<>=~!@#%^&|`?" n+ , not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)+ , not (T.last x `T.elem` "+-")+ || or (map (`T.elem` x) "~!@#%^&|`?")+ ]++{-+These are postgres operators, which if followed immediately by a + or+-, will lex as separate operators rather than one operator including+the + or -.+-}++somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [Text]+somePostgresOpsWhichWontAddTrailingPlusMinus l =+ [ x+ | n <- [1..l]+ , x <- combos "+-*/<>=" n+ , not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)+ , not (T.last x `T.elem` "+-")+ ]+++postgresLexerTests :: TestItem+postgresLexerTests = Group "postgresLexerTests" $+ [Group "postgres lexer token tests" $+ [LexTest postgres s t | (s,t) <- postgresLexerTable]+ ,Group "postgres generated lexer token tests" $+ [LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]+ ,Group "postgres generated combination lexer tests" $+ [ LexTest postgres (s <> s1) (t <> t1)+ | (s,t) <- postgresLexerTable ++ postgresShortOperatorTable+ , (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable+ , tokenListWillPrintAndLex postgres $ t ++ t1++ ]+ ,Group "generated postgres edgecase lexertests" $+ [LexTest postgres s t+ | (s,t) <- edgeCaseCommentOps+ ++ edgeCasePlusMinusOps+ ++ edgeCasePlusMinusComments]++ ,Group "adhoc postgres lexertests" $+ -- need more tests for */ to make sure it is caught if it is in the middle of a+ -- sequence of symbol letters+ [LexFails postgres "*/"+ ,LexFails postgres ":::"+ ,LexFails postgres "::::"+ ,LexFails postgres ":::::"+ ,LexFails postgres "@*/"+ ,LexFails postgres "-*/"+ ,LexFails postgres "12e3e4"+ ,LexFails postgres "12e3e4"+ ,LexFails postgres "12e3e4"+ ,LexFails postgres "12e3.4"+ ,LexFails postgres "12.4.5"+ ,LexFails postgres "12.4e5.6"+ ,LexFails postgres "12.4e5e7"+ -- special case allow this to lex to 1 .. 2+ -- this is for 'for loops' in plpgsql+ ,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]+ ]+ where+ edgeCaseCommentOps =+ [ (x <> "/*<test*/", [Symbol x, BlockComment "/*<test*/"])+ | x <- eccops+ , not (T.last x == '*')+ ] +++ [ (x <> "--<test", [Symbol x, LineComment "--<test"])+ | x <- eccops+ , not (T.last x == '-')+ ]+ eccops = someValidPostgresOperators 2+ edgeCasePlusMinusOps = concat+ [ [ (x <> "+", [Symbol x, Symbol "+"])+ , (x <> "-", [Symbol x, Symbol "-"]) ]+ | x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2+ ]+ edgeCasePlusMinusComments =+ [("---", [LineComment "---"])+ ,("+--", [Symbol "+", LineComment "--"])+ ,("-/**/", [Symbol "-", BlockComment "/**/"])+ ,("+/**/", [Symbol "+", BlockComment "/**/"])+ ]++sqlServerLexerTests :: TestItem+sqlServerLexerTests = Group "sqlServerLexTests" $+ [ LexTest sqlserver s t | (s,t) <-+ [("@variable", [(PrefixedVariable '@' "variable")])+ ,("#variable", [(PrefixedVariable '#' "variable")])+ ,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])+ ]]++oracleLexerTests :: TestItem+oracleLexerTests = Group "oracleLexTests" $+ [] -- nothing oracle specific atm++mySqlLexerTests :: TestItem+mySqlLexerTests = Group "mySqlLexerTests" $+ [ LexTest mysql s t | (s,t) <-+ [("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])+ ]+ ]++odbcLexerTests :: TestItem+odbcLexerTests = Group "odbcLexTests" $+ [ LexTest sqlserver {diOdbc = True} s t | (s,t) <-+ [("{}", [Symbol "{", Symbol "}"])+ ]]+ ++ [LexFails sqlserver {diOdbc = False} "{"+ ,LexFails sqlserver {diOdbc = False} "}"]++combos :: [Char] -> Int -> [Text]+combos _ 0 = [T.empty]+combos l n = [ T.cons x tl | x <- l, tl <- combos l (n - 1) ]
+ tests/Language/SQL/SimpleSQL/MySQL.hs view
@@ -0,0 +1,43 @@++-- Tests for mysql dialect parsing++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.MySQL (mySQLTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++mySQLTests :: TestItem+mySQLTests = Group "mysql dialect"+ [backtickQuotes+ ,limit]++{-+backtick quotes++limit syntax++[LIMIT {[offset,] row_count | row_count OFFSET offset}]+-}++backtickQuotes :: TestItem+backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))+ [("`test`", Iden [Name (Just ("`","`")) "test"])+ ]+ ++ [ParseScalarExprFails ansi2011 "`test`"]+ )++limit :: TestItem+limit = Group "queries" ( map (uncurry (TestQueryExpr mysql))+ [("select * from t limit 5"+ ,toQueryExpr $ sel {msFetchFirst = Just (NumLit "5")}+ )+ ]+ ++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"+ ,ParseQueryExprFails ansi2011 "select * from t limit 5"]+ )+ where+ sel = makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }
+ tests/Language/SQL/SimpleSQL/Odbc.hs view
@@ -0,0 +1,53 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Odbc (odbcTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++odbcTests :: TestItem+odbcTests = Group "odbc" [+ Group "datetime" [+ e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")+ ,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")+ ,e "{ts '2000-01-01 12:00:01.1'}"+ (OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")+ ]+ ,Group "functions" [+ e "{fn CHARACTER_LENGTH(string_exp)}"+ $ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])+ ,e "{fn EXTRACT(day from t)}"+ $ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])+ ,e "{fn now()}"+ $ OdbcFunc (ap "now" [])+ ,e "{fn CONVERT('2000-01-01', SQL_DATE)}"+ $ OdbcFunc (ap "CONVERT"+ [StringLit "'" "'" "2000-01-01"+ ,iden "SQL_DATE"])+ ,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"+ $ OdbcFunc (ap "CONVERT"+ [OdbcFunc (ap "CURDATE" [])+ ,iden "SQL_DATE"])+ ]+ ,Group "outer join" [+ TestQueryExpr ansi2011 {diOdbc=True}+ "select * from {oj t1 left outer join t2 on expr}"+ $ toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"])+ (Just $ JoinOn $ Iden [Name Nothing "expr"])]}]+ ,Group "check parsing bugs" [+ TestQueryExpr ansi2011 {diOdbc=True}+ "select {fn CONVERT(cint,SQL_BIGINT)} from t;"+ $ toQueryExpr $ makeSelect+ {msSelectList = [(OdbcFunc (ap "CONVERT"+ [iden "cint"+ ,iden "SQL_BIGINT"]), Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}]+ ]+ where+ e = TestScalarExpr ansi2011 {diOdbc = True}+ --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}+ ap n = App [Name Nothing n]+ iden n = Iden [Name Nothing n]+
+ tests/Language/SQL/SimpleSQL/Oracle.hs view
@@ -0,0 +1,30 @@++-- Tests for oracle dialect parsing++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Oracle (oracleTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++oracleTests :: TestItem+oracleTests = Group "oracle dialect"+ [oracleLobUnits]+++oracleLobUnits :: TestItem+oracleLobUnits = Group "oracleLobUnits" (map (uncurry (TestScalarExpr oracle))+ [("cast (a as varchar2(3 char))"+ ,Cast (Iden [Name Nothing "a"]) (+ PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters)))+ ,("cast (a as varchar2(3 byte))"+ ,Cast (Iden [Name Nothing "a"]) (+ PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecOctets)))+ ]+ ++ [TestStatement oracle+ "create table t (a varchar2(55 BYTE));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a")+ (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))+ Nothing []]]+ )
+ tests/Language/SQL/SimpleSQL/Postgres.hs view
@@ -0,0 +1,279 @@++{-+Here are some tests taken from the SQL in the postgres manual. Almost+all of the postgres specific syntax has been skipped, this can be+revisited when the dialect support is added.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Postgres (postgresTests) where++import Language.SQL.SimpleSQL.TestTypes++postgresTests :: TestItem+postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)++{-+lexical syntax section++TODO: get all the commented out tests working+-}++ [-- "SELECT 'foo'\n\+ -- \'bar';" -- this should parse as select 'foobar'+ -- ,+ "SELECT name, (SELECT max(pop) FROM cities\n\+ \ WHERE cities.state = states.name)\n\+ \ FROM states;"+ ,"SELECT ROW(1,2.5,'this is a test');"++ ,"SELECT ROW(t.*, 42) FROM t;"+ ,"SELECT ROW(t.f1, t.f2, 42) FROM t;"+ ,"SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));"++ ,"SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');"++ -- table is a reservered keyword?+ --,"SELECT ROW(table.*) IS NULL FROM table;"+ ,"SELECT ROW(tablex.*) IS NULL FROM tablex;"++ ,"SELECT true OR somefunc();"++ ,"SELECT somefunc() OR true;"++-- queries section++ ,"SELECT * FROM t1 CROSS JOIN t2;"+ ,"SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"+ ,"SELECT * FROM t1 INNER JOIN t2 USING (num);"+ ,"SELECT * FROM t1 NATURAL INNER JOIN t2;"+ ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"+ ,"SELECT * FROM t1 LEFT JOIN t2 USING (num);"+ ,"SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"+ ,"SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"+ ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"+ ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"++ ,"SELECT * FROM some_very_long_table_name s\n\+ \JOIN another_fairly_long_name a ON s.id = a.num;"+ ,"SELECT * FROM people AS mother JOIN people AS child\n\+ \ ON mother.id = child.mother_id;"+ ,"SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"+ ,"SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"+ ,"SELECT * FROM getfoo(1) AS t1;"+ ,"SELECT * FROM foo\n\+ \ WHERE foosubid IN (\n\+ \ SELECT foosubid\n\+ \ FROM getfoo(foo.fooid) z\n\+ \ WHERE z.fooid = foo.fooid\n\+ \ );"+ {-,"SELECT *\n\+ \ FROM dblink('dbname=mydb', 'SELECT proname, prosrc FROM pg_proc')\n\+ \ AS t1(proname name, prosrc text)\n\+ \ WHERE proname LIKE 'bytea%';"-} -- types in the alias??++ ,"SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"+ ,"SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"++ {-,"SELECT p1.id, p2.id, v1, v2\n\+ \FROM polygons p1, polygons p2,\n\+ \ LATERAL vertices(p1.poly) v1,\n\+ \ LATERAL vertices(p2.poly) v2\n\+ \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-} -- <-> operator?++ {-,"SELECT p1.id, p2.id, v1, v2\n\+ \FROM polygons p1 CROSS JOIN LATERAL vertices(p1.poly) v1,\n\+ \ polygons p2 CROSS JOIN LATERAL vertices(p2.poly) v2\n\+ \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-}++ ,"SELECT m.name\n\+ \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true\n\+ \WHERE pname IS NULL;"+++ ,"SELECT * FROM fdt WHERE c1 > 5"++ ,"SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"++ ,"SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"++ ,"SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"++ ,"SELECT * FROM fdt WHERE c1 BETWEEN \n\+ \ (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100"++ ,"SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"++ ,"SELECT * FROM test1;"++ ,"SELECT x FROM test1 GROUP BY x;"+ ,"SELECT x, sum(y) FROM test1 GROUP BY x;"+ -- s.date changed to s.datex because of reserved keyword+ -- handling, not sure if this is correct or not for ansi sql+ ,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\+ \ FROM products p LEFT JOIN sales s USING (product_id)\n\+ \ GROUP BY product_id, p.name, p.price;"++ ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"+ ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"+ ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\+ \ FROM products p LEFT JOIN sales s USING (product_id)\n\+ \ WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\+ \ GROUP BY product_id, p.name, p.price, p.cost\n\+ \ HAVING sum(p.price * s.units) > 5000;"++ ,"SELECT a, b, c FROM t"++ ,"SELECT tbl1.a, tbl2.a, tbl1.b FROM t"++ ,"SELECT tbl1.*, tbl2.a FROM t"++ ,"SELECT a AS value, b + c AS sum FROM t"++ ,"SELECT a \"value\", b + c AS sum FROM t"++ ,"SELECT DISTINCT select_list t"++ ,"VALUES (1, 'one'), (2, 'two'), (3, 'three');"++ ,"SELECT 1 AS column1, 'one' AS column2\n\+ \UNION ALL\n\+ \SELECT 2, 'two'\n\+ \UNION ALL\n\+ \SELECT 3, 'three';"++ ,"SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"++ ,"WITH regional_sales AS (\n\+ \ SELECT region, SUM(amount) AS total_sales\n\+ \ FROM orders\n\+ \ GROUP BY region\n\+ \ ), top_regions AS (\n\+ \ SELECT region\n\+ \ FROM regional_sales\n\+ \ WHERE total_sales > (SELECT SUM(total_sales)/10 FROM regional_sales)\n\+ \ )\n\+ \SELECT region,\n\+ \ product,\n\+ \ SUM(quantity) AS product_units,\n\+ \ SUM(amount) AS product_sales\n\+ \FROM orders\n\+ \WHERE region IN (SELECT region FROM top_regions)\n\+ \GROUP BY region, product;"++ ,"WITH RECURSIVE t(n) AS (\n\+ \ VALUES (1)\n\+ \ UNION ALL\n\+ \ SELECT n+1 FROM t WHERE n < 100\n\+ \)\n\+ \SELECT sum(n) FROM t"++ ,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\+ \ SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'\n\+ \ UNION ALL\n\+ \ SELECT p.sub_part, p.part, p.quantity\n\+ \ FROM included_parts pr, parts p\n\+ \ WHERE p.part = pr.sub_part\n\+ \ )\n\+ \SELECT sub_part, SUM(quantity) as total_quantity\n\+ \FROM included_parts\n\+ \GROUP BY sub_part"++ ,"WITH RECURSIVE search_graph(id, link, data, depth) AS (\n\+ \ SELECT g.id, g.link, g.data, 1\n\+ \ FROM graph g\n\+ \ UNION ALL\n\+ \ SELECT g.id, g.link, g.data, sg.depth + 1\n\+ \ FROM graph g, search_graph sg\n\+ \ WHERE g.id = sg.link\n\+ \)\n\+ \SELECT * FROM search_graph;"++ {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\+ \ SELECT g.id, g.link, g.data, 1,\n\+ \ ARRAY[g.id],\n\+ \ false\n\+ \ FROM graph g\n\+ \ UNION ALL\n\+ \ SELECT g.id, g.link, g.data, sg.depth + 1,\n\+ \ path || g.id,\n\+ \ g.id = ANY(path)\n\+ \ FROM graph g, search_graph sg\n\+ \ WHERE g.id = sg.link AND NOT cycle\n\+ \)\n\+ \SELECT * FROM search_graph;"-} -- ARRAY++ {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\+ \ SELECT g.id, g.link, g.data, 1,\n\+ \ ARRAY[ROW(g.f1, g.f2)],\n\+ \ false\n\+ \ FROM graph g\n\+ \ UNION ALL\n\+ \ SELECT g.id, g.link, g.data, sg.depth + 1,\n\+ \ path || ROW(g.f1, g.f2),\n\+ \ ROW(g.f1, g.f2) = ANY(path)\n\+ \ FROM graph g, search_graph sg\n\+ \ WHERE g.id = sg.link AND NOT cycle\n\+ \)\n\+ \SELECT * FROM search_graph;"-} -- ARRAY++ ,"WITH RECURSIVE t(n) AS (\n\+ \ SELECT 1\n\+ \ UNION ALL\n\+ \ SELECT n+1 FROM t\n\+ \)\n\+ \SELECT n FROM t --LIMIT 100;" -- limit is not standard++-- select page reference++ ,"SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\+ \ FROM distributors d, films f\n\+ \ WHERE f.did = d.did"++ ,"SELECT kind, sum(len) AS total\n\+ \ FROM films\n\+ \ GROUP BY kind\n\+ \ HAVING sum(len) < interval '5 hours';"++ ,"SELECT * FROM distributors ORDER BY name;"+ ,"SELECT * FROM distributors ORDER BY 2;"++ ,"SELECT distributors.name\n\+ \ FROM distributors\n\+ \ WHERE distributors.name LIKE 'W%'\n\+ \UNION\n\+ \SELECT actors.name\n\+ \ FROM actors\n\+ \ WHERE actors.name LIKE 'W%';"++ ,"WITH t AS (\n\+ \ SELECT random() as x FROM generate_series(1, 3)\n\+ \ )\n\+ \SELECT * FROM t\n\+ \UNION ALL\n\+ \SELECT * FROM t"++ ,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\+ \ SELECT 1, employee_name, manager_name\n\+ \ FROM employee\n\+ \ WHERE manager_name = 'Mary'\n\+ \ UNION ALL\n\+ \ SELECT er.distance + 1, e.employee_name, e.manager_name\n\+ \ FROM employee_recursive er, employee e\n\+ \ WHERE er.employee_name = e.manager_name\n\+ \ )\n\+ \SELECT distance, employee_name FROM employee_recursive;"++ ,"SELECT m.name AS mname, pname\n\+ \FROM manufacturers m, LATERAL get_product_names(m.id) pname;"++ ,"SELECT m.name AS mname, pname\n\+ \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"++ ,"SELECT 2+2;"++ -- simple-sql-parser doesn't support where without from+ -- this can be added for the postgres dialect when it is written+ --,"SELECT distributors.* WHERE distributors.name = 'Westward';"++ ]
+ tests/Language/SQL/SimpleSQL/QueryExprComponents.hs view
@@ -0,0 +1,209 @@++{-+These are the tests for the query expression components apart from the+table refs which are in a separate file.+++These are a few misc tests which don't fit anywhere else.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+++queryExprComponentTests :: TestItem+queryExprComponentTests = Group "queryExprComponentTests"+ [duplicates+ ,selectLists+ ,whereClause+ ,having+ ,orderBy+ ,offsetFetch+ ,combos+ ,withQueries+ ,values+ ,tables+ ]++++duplicates :: TestItem+duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a from t" ,ms SQDefault)+ ,("select all a from t" ,ms All)+ ,("select distinct a from t", ms Distinct)+ ]+ where+ ms d = toQueryExpr $ makeSelect+ {msSetQuantifier = d+ ,msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}++selectLists :: TestItem+selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))+ [("select 1",+ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]})++ ,("select a"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]})++ ,("select a,b"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)+ ,(Iden [Name Nothing "b"],Nothing)]})++ ,("select 1+2,3+4"+ ,toQueryExpr $ makeSelect {msSelectList =+ [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)+ ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]})++ ,("select a as a, /*comment*/ b as b"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")+ ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})++ ,("select a a, b b"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")+ ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})++ ,("select a + b * c"+ ,toQueryExpr $ makeSelect {msSelectList =+ [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]+ (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))+ ,Nothing)]})++ ]++whereClause :: TestItem+whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a from t where a = 5"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})+ ]++having :: TestItem+having = Group "having" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a,sum(b) from t group by a having sum(b) > 5"+ ,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)+ ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+ ,msHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]])+ [Name Nothing ">"] (NumLit "5")+ })+ ]++orderBy :: TestItem+orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a from t order by a"+ ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault])++ ,("select a from t order by a, b"+ ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault])++ ,("select a from t order by a asc"+ ,ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault])++ ,("select a from t order by a desc, b desc"+ ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault])++ ,("select a from t order by a desc nulls first, b desc nulls last"+ ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst+ ,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast])++ ]+ where+ ms o = toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msOrderBy = o}++offsetFetch :: TestItem+offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))+ [-- ansi standard+ ("select a from t offset 5 rows fetch next 10 rows only"+ ,ms (Just $ NumLit "5") (Just $ NumLit "10"))+ ,("select a from t offset 5 rows;"+ ,ms (Just $ NumLit "5") Nothing)+ ,("select a from t fetch next 10 row only;"+ ,ms Nothing (Just $ NumLit "10"))+ ,("select a from t offset 5 row fetch first 10 row only"+ ,ms (Just $ NumLit "5") (Just $ NumLit "10"))+ -- postgres: disabled, will add back when postgres+ -- dialect is added+ --,("select a from t limit 10 offset 5"+ -- ,ms (Just $ NumLit "5") (Just $ NumLit "10"))+ ]+ where+ ms o l = toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msOffset = o+ ,msFetchFirst = l}++combos :: TestItem+combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a from t union select b from u"+ ,QueryExprSetOp mst Union SQDefault Respectively msu)++ ,("select a from t intersect select b from u"+ ,QueryExprSetOp mst Intersect SQDefault Respectively msu)++ ,("select a from t except all select b from u"+ ,QueryExprSetOp mst Except All Respectively msu)++ ,("select a from t union distinct corresponding \+ \select b from u"+ ,QueryExprSetOp mst Union Distinct Corresponding msu)++ ,("select a from t union select a from t union select a from t"+ ,QueryExprSetOp (QueryExprSetOp mst Union SQDefault Respectively mst)+ Union SQDefault Respectively mst)+ ]+ where+ mst = toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}+ msu = toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "b"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "u"]]}+++withQueries :: TestItem+withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))+ [("with u as (select a from t) select a from u"+ ,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2)++ ,("with u(b) as (select a from t) select a from u"+ ,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2)++ ,("with x as (select a from t),\n\+ \ u as (select a from x)\n\+ \select a from u"+ ,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2)++ ,("with recursive u as (select a from t) select a from u"+ ,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2)+ ]+ where+ ms c t = toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing c],Nothing)]+ ,msFrom = [TRSimple [Name Nothing t]]}+ ms1 = ms "a" "t"+ ms2 = ms "a" "u"+ ms3 = ms "a" "x"++values :: TestItem+values = Group "values" $ map (uncurry (TestQueryExpr ansi2011))+ [("values (1,2),(3,4)"+ ,Values [[NumLit "1", NumLit "2"]+ ,[NumLit "3", NumLit "4"]])+ ]++tables :: TestItem+tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))+ [("table tbl", Table [Name Nothing "tbl"])+ ]
+ tests/Language/SQL/SimpleSQL/QueryExprs.hs view
@@ -0,0 +1,27 @@++{-+These are the tests for the queryExprs parsing which parses multiple+query expressions from one string.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.QueryExprs (queryExprsTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++queryExprsTests :: TestItem+queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011))+ [("select 1",[ms])+ ,("select 1;",[ms])+ ,("select 1;select 1",[ms,ms])+ ,(" select 1;select 1; ",[ms,ms])+ ,("SELECT CURRENT_TIMESTAMP;"+ ,[SelectStatement $ toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}])+ ,("SELECT \"CURRENT_TIMESTAMP\";"+ ,[SelectStatement $ toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}])+ ]+ where+ ms = SelectStatement $ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]}
+ tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs view
@@ -0,0 +1,330 @@++{-+Section 12 in Foundation++grant, etc+-}+++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++sql2011AccessControlTests :: TestItem+sql2011AccessControlTests = Group "sql 2011 access control tests" [++{-+12 Access control++12.1 <grant statement>++<grant statement> ::=+ <grant privilege statement>+ | <grant role statement>++12.2 <grant privilege statement>++<grant privilege statement> ::=+ GRANT <privileges> TO <grantee> [ { <comma> <grantee> }... ]+ [ WITH HIERARCHY OPTION ]+ [ WITH GRANT OPTION ]+ [ GRANTED BY <grantor> ]++12.3 <privileges>+<privileges> ::=+ <object privileges> ON <object name>++<object name> ::=+ [ TABLE ] <table name>+ | DOMAIN <domain name>+ | COLLATION <collation name>+ | CHARACTER SET <character set name>+ | TRANSLATION <transliteration name>+ | TYPE <schema-resolved user-defined type name>+ | SEQUENCE <sequence generator name>+ | <specific routine designator>++<object privileges> ::=+ ALL PRIVILEGES+ | <action> [ { <comma> <action> }... ]++<action> ::=+ SELECT+ | SELECT <left paren> <privilege column list> <right paren>+ | SELECT <left paren> <privilege method list> <right paren>+ | DELETE+ | INSERT [ <left paren> <privilege column list> <right paren> ]+ | UPDATE [ <left paren> <privilege column list> <right paren> ]+ | REFERENCES [ <left paren> <privilege column list> <right paren> ]+ | USAGE+ | TRIGGER+ | UNDER+ | EXECUTE++<privilege method list> ::=+ <specific routine designator> [ { <comma> <specific routine designator> }... ]++<privilege column list> ::=+ <column name list>++<grantee> ::=+ PUBLIC+ | <authorization identifier>++<grantor> ::=+ CURRENT_USER+ | CURRENT_ROLE+-}++ (TestStatement ansi2011+ "grant all privileges on tbl1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1"] WithoutGrantOption)+++ ,(TestStatement ansi2011+ "grant all privileges on tbl1 to role1,role2"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant all privileges on tbl1 to role1 with grant option"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1"] WithGrantOption)++ ,(TestStatement ansi2011+ "grant all privileges on table tbl1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant all privileges on domain mydom to role1"+ $ GrantPrivilege [PrivAll]+ (PrivDomain [Name Nothing "mydom"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant all privileges on type t1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivType [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant all privileges on sequence s1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivSequence [Name Nothing "s1"])+ [Name Nothing "role1"] WithoutGrantOption)+++ ,(TestStatement ansi2011+ "grant select on table t1 to role1"+ $ GrantPrivilege [PrivSelect []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant select(a,b) on table t1 to role1"+ $ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant delete on table t1 to role1"+ $ GrantPrivilege [PrivDelete]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant insert on table t1 to role1"+ $ GrantPrivilege [PrivInsert []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant insert(a,b) on table t1 to role1"+ $ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant update on table t1 to role1"+ $ GrantPrivilege [PrivUpdate []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant update(a,b) on table t1 to role1"+ $ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant references on table t1 to role1"+ $ GrantPrivilege [PrivReferences []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant references(a,b) on table t1 to role1"+ $ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant usage on table t1 to role1"+ $ GrantPrivilege [PrivUsage]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant trigger on table t1 to role1"+ $ GrantPrivilege [PrivTrigger]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)+++ ,(TestStatement ansi2011+ "grant execute on specific function f to role1"+ $ GrantPrivilege [PrivExecute]+ (PrivFunction [Name Nothing "f"])+ [Name Nothing "role1"] WithoutGrantOption)++ ,(TestStatement ansi2011+ "grant select,delete on table t1 to role1"+ $ GrantPrivilege [PrivSelect [], PrivDelete]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption)++{-+skipping for now:++what is 'under' action?++collation, character set, translation, member thing, methods++for review++some pretty big things missing in the standard:++schema, database++functions, etc., by argument types since they can be overloaded++++12.4 <role definition>++<role definition> ::=+ CREATE ROLE <role name> [ WITH ADMIN <grantor> ]+-}++ ,(TestStatement ansi2011+ "create role rolee"+ $ CreateRole (Name Nothing "rolee"))+++{-+12.5 <grant role statement>++<grant role statement> ::=+ GRANT <role granted> [ { <comma> <role granted> }... ]+ TO <grantee> [ { <comma> <grantee> }... ]+ [ WITH ADMIN OPTION ]+ [ GRANTED BY <grantor> ]++<role granted> ::=+ <role name>+-}++ ,(TestStatement ansi2011+ "grant role1 to public"+ $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)++ ,(TestStatement ansi2011+ "grant role1,role2 to role3,role4"+ $ GrantRole [Name Nothing "role1",Name Nothing "role2"]+ [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)++ ,(TestStatement ansi2011+ "grant role1 to role3 with admin option"+ $ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)+++{-+12.6 <drop role statement>++<drop role statement> ::=+ DROP ROLE <role name>+-}++ ,(TestStatement ansi2011+ "drop role rolee"+ $ DropRole (Name Nothing "rolee"))+++{-+12.7 <revoke statement>++<revoke statement> ::=+ <revoke privilege statement>+ | <revoke role statement>++<revoke privilege statement> ::=+ REVOKE [ <revoke option extension> ] <privileges>+ FROM <grantee> [ { <comma> <grantee> }... ]+ [ GRANTED BY <grantor> ]+ <drop behavior>++<revoke option extension> ::=+ GRANT OPTION FOR+ | HIERARCHY OPTION FOR+-}+++ ,(TestStatement ansi2011+ "revoke select on t1 from role1"+ $ RevokePrivilege NoGrantOptionFor [PrivSelect []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "revoke grant option for select on t1 from role1,role2 cascade"+ $ RevokePrivilege GrantOptionFor [PrivSelect []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1",Name Nothing "role2"] Cascade)+++{-+<revoke role statement> ::=+ REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]+ FROM <grantee> [ { <comma> <grantee> }... ]+ [ GRANTED BY <grantor> ]+ <drop behavior>++<role revoked> ::=+ <role name>+-}++ ,(TestStatement ansi2011+ "revoke role1 from role2"+ $ RevokeRole NoAdminOptionFor [Name Nothing "role1"]+ [Name Nothing "role2"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "revoke role1,role2 from role3,role4"+ $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]+ [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)+++ ,(TestStatement ansi2011+ "revoke admin option for role1 from role2 cascade"+ $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade)+++ ]
+ tests/Language/SQL/SimpleSQL/SQL2011Bits.hs view
@@ -0,0 +1,234 @@++{-+Sections 17 and 19 in Foundation++This module covers the tests for transaction management (begin,+commit, savepoint, etc.), and session management (set).+-}+++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++sql2011BitsTests :: TestItem+sql2011BitsTests = Group "sql 2011 bits tests" [++{-+17 Transaction management++17.1 <start transaction statement>++<start transaction statement> ::=+ START TRANSACTION [ <transaction characteristics> ]++BEGIN is not in the standard!+-}++ (TestStatement ansi2011+ "start transaction"+ $ StartTransaction)++{-+17.2 <set transaction statement>++<set transaction statement> ::=+ SET [ LOCAL ] TRANSACTION <transaction characteristics>++17.3 <transaction characteristics>++<transaction characteristics> ::=+ [ <transaction mode> [ { <comma> <transaction mode> }... ] ]++<transaction mode> ::=+ <isolation level>+ | <transaction access mode>+ | <diagnostics size>++<transaction access mode> ::=+ READ ONLY+ | READ WRITE++<isolation level> ::=+ ISOLATION LEVEL <level of isolation>++<level of isolation> ::=+ READ UNCOMMITTED+ | READ COMMITTED+ | REPEATABLE READ+ | SERIALIZABLE++<diagnostics size> ::=+ DIAGNOSTICS SIZE <number of conditions>++<number of conditions> ::=+ <simple value specification>++17.4 <set constraints mode statement>++<set constraints mode statement> ::=+ SET CONSTRAINTS <constraint name list> { DEFERRED | IMMEDIATE }++<constraint name list> ::=+ ALL+ | <constraint name> [ { <comma> <constraint name> }... ]++17.5 <savepoint statement>++<savepoint statement> ::=+ SAVEPOINT <savepoint specifier>++<savepoint specifier> ::=+ <savepoint name>+-}++ ,(TestStatement ansi2011+ "savepoint difficult_bit"+ $ Savepoint $ Name Nothing "difficult_bit")+++{-+17.6 <release savepoint statement>++<release savepoint statement> ::=+ RELEASE SAVEPOINT <savepoint specifier>+-}++ ,(TestStatement ansi2011+ "release savepoint difficult_bit"+ $ ReleaseSavepoint $ Name Nothing "difficult_bit")+++{-+17.7 <commit statement>++<commit statement> ::=+ COMMIT [ WORK ] [ AND [ NO ] CHAIN ]+-}++ ,(TestStatement ansi2011+ "commit"+ $ Commit)++ ,(TestStatement ansi2011+ "commit work"+ $ Commit)+++{-+17.8 <rollback statement>++<rollback statement> ::=+ ROLLBACK [ WORK ] [ AND [ NO ] CHAIN ] [ <savepoint clause> ]++<savepoint clause> ::=+ TO SAVEPOINT <savepoint specifier>+-}++ ,(TestStatement ansi2011+ "rollback"+ $ Rollback Nothing)++ ,(TestStatement ansi2011+ "rollback work"+ $ Rollback Nothing)++ ,(TestStatement ansi2011+ "rollback to savepoint difficult_bit"+ $ Rollback $ Just $ Name Nothing "difficult_bit")+++{-+19 Session management++19.1 <set session characteristics statement>++<set session characteristics statement> ::=+ SET SESSION CHARACTERISTICS AS <session characteristic list>++<session characteristic list> ::=+ <session characteristic> [ { <comma> <session characteristic> }... ]++<session characteristic> ::=+ <session transaction characteristics>++<session transaction characteristics> ::=+ TRANSACTION <transaction mode> [ { <comma> <transaction mode> }... ]++19.2 <set session user identifier statement>++<set session user identifier statement> ::=+ SET SESSION AUTHORIZATION <value specification>++19.3 <set role statement>++<set role statement> ::=+ SET ROLE <role specification>++<role specification> ::=+ <value specification>+ | NONE++19.4 <set local time zone statement>++<set local time zone statement> ::=+ SET TIME ZONE <set time zone value>++<set time zone value> ::=+ <interval value expression>+ | LOCAL++19.5 <set catalog statement>++<set catalog statement> ::=+ SET <catalog name characteristic>++<catalog name characteristic> ::=+ CATALOG <value specification>++19.6 <set schema statement>++<set schema statement> ::=+ SET <schema name characteristic>++<schema name characteristic> ::=+ SCHEMA <value specification>++19.7 <set names statement>++<set names statement> ::=+ SET <character set name characteristic>++<character set name characteristic> ::=+ NAMES <value specification>++19.8 <set path statement>++<set path statement> ::=+ SET <SQL-path characteristic>++<SQL-path characteristic> ::=+ PATH <value specification>++19.9 <set transform group statement>++<set transform group statement> ::=+ SET <transform group characteristic>++<transform group characteristic> ::=+ DEFAULT TRANSFORM GROUP <value specification>+ | TRANSFORM GROUP FOR TYPE <path-resolved user-defined type name> <value specification>++19.10 <set session collation statement>++<set session collation statement> ::=+ SET COLLATION <collation specification> [ FOR <character set specification list> ]+ | SET NO COLLATION [ FOR <character set specification list> ]++<collation specification> ::=+ <value specification>+-}++ ]
+ tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs view
@@ -0,0 +1,555 @@++-- Section 14 in Foundation+++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++sql2011DataManipulationTests :: TestItem+sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"+ [+++{-+14 Data manipulation+++14.1 <declare cursor>++<declare cursor> ::=+ DECLARE <cursor name> <cursor properties>+ FOR <cursor specification>++14.2 <cursor properties>++<cursor properties> ::=+ [ <cursor sensitivity> ] [ <cursor scrollability> ] CURSOR+ [ <cursor holdability> ]+ [ <cursor returnability> ]++<cursor sensitivity> ::=+ SENSITIVE+ | INSENSITIVE+ | ASENSITIVE++<cursor scrollability> ::=+ SCROLL+ | NO SCROLL++<cursor holdability> ::=+ WITH HOLD+ | WITHOUT HOLD++<cursor returnability> ::=+ WITH RETURN+ | WITHOUT RETURN++14.3 <cursor specification>++<cursor specification> ::=+ <query expression> [ <updatability clause> ]++<updatability clause> ::=+ FOR { READ ONLY | UPDATE [ OF <column name list> ] }++14.4 <open statement>++<open statement> ::=+ OPEN <cursor name>++14.5 <fetch statement>++<fetch statement> ::=+ FETCH [ [ <fetch orientation> ] FROM ] <cursor name> INTO <fetch target list>++<fetch orientation> ::=+ NEXT+ | PRIOR+ | FIRST+ | LAST+ | { ABSOLUTE | RELATIVE } <simple value specification>++<fetch target list> ::=+ <target specification> [ { <comma> <target specification> }... ]+++14.6 <close statement>++<close statement> ::=+ CLOSE <cursor name>++14.7 <select statement: single row>++<select statement: single row> ::=+ SELECT [ <set quantifier> ] <select list>+ INTO <select target list>+ <table expression>++<select target list> ::=+ <target specification> [ { <comma> <target specification> }... ]++14.8 <delete statement: positioned>++<delete statement: positioned> ::=+ DELETE FROM <target table> [ [ AS ] <correlation name> ]+ WHERE CURRENT OF <cursor name>++<target table> ::=+ <table name>+ | ONLY <left paren> <table name> <right paren>++14.9 <delete statement: searched>++<delete statement: searched> ::=+ DELETE FROM <target table>+ [ FOR PORTION OF <application time period name>+ FROM <point in time 1> TO <point in time 2> ]+ [ [ AS ] <correlation name> ]+ [ WHERE <search condition> ]+-}++ (TestStatement ansi2011 "delete from t"+ $ Delete [Name Nothing "t"] Nothing Nothing)++ ,(TestStatement ansi2011 "delete from t as u"+ $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing)++ ,(TestStatement ansi2011 "delete from t where x = 5"+ $ Delete [Name Nothing "t"] Nothing+ (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))+++ ,(TestStatement ansi2011 "delete from t as u where u.x = 5"+ $ Delete [Name Nothing "t"] (Just (Name Nothing "u"))+ (Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))++{-+14.10 <truncate table statement>++<truncate table statement> ::=+ TRUNCATE TABLE <target table> [ <identity column restart option> ]++<identity column restart option> ::=+ CONTINUE IDENTITY+ | RESTART IDENTITY+-}++ ,(TestStatement ansi2011 "truncate table t"+ $ Truncate [Name Nothing "t"] DefaultIdentityRestart)++ ,(TestStatement ansi2011 "truncate table t continue identity"+ $ Truncate [Name Nothing "t"] ContinueIdentity)++ ,(TestStatement ansi2011 "truncate table t restart identity"+ $ Truncate [Name Nothing "t"] RestartIdentity)+++{-+14.11 <insert statement>++<insert statement> ::=+ INSERT INTO <insertion target> <insert columns and source>++<insertion target> ::=+ <table name>++<insert columns and source> ::=+ <from subquery>+ | <from constructor>+ | <from default>++<from subquery> ::=+ [ <left paren> <insert column list> <right paren> ]+ [ <override clause> ]+ <query expression>++<from constructor> ::=+ [ <left paren> <insert column list> <right paren> ]+ [ <override clause> ]+ <contextually typed table value constructor>++<override clause> ::=+ OVERRIDING USER VALUE+ | OVERRIDING SYSTEM VALUE++<from default> ::=+ DEFAULT VALUES++<insert column list> ::=+ <column name list>+-}++ ,(TestStatement ansi2011 "insert into t select * from u"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "u"]]})++ ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"+ $ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"])+ $ InsertQuery $ toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "u"]]})++ ,(TestStatement ansi2011 "insert into t default values"+ $ Insert [Name Nothing "t"] Nothing DefaultInsertValues)++ ,(TestStatement ansi2011 "insert into t values(1,2)"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ Values [[NumLit "1", NumLit "2"]])++ ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ Values [[NumLit "1", NumLit "2"]+ ,[NumLit "3", NumLit "4"]])++ ,(TestStatement ansi2011+ "insert into t values (default,null,array[],multiset[])"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ Values [[Iden [Name Nothing "default"]+ ,Iden [Name Nothing "null"]+ ,Array (Iden [Name Nothing "array"]) []+ ,MultisetCtor []]])+++{-+14.12 <merge statement>++<merge statement> ::=+ MERGE INTO <target table> [ [ AS ] <merge correlation name> ]+ USING <table reference>+ ON <search condition> <merge operation specification>++merge into t+ using t+ on a = b+ merge operation specification++merge into t as u+using (table factor | joined expression)++ MERGE INTO tablename USING table_reference ON (condition)+ WHEN MATCHED THEN+ UPDATE SET column1 = value1 [, column2 = value2 ...]+ WHEN NOT MATCHED THEN+ INSERT (column1 [, column2 ...]) VALUES (value1 [, value2 ...++merge into t23+using t42+on t42.id = t23.id+when matched then+ update+ set t23.col1 = t42.col1+when not matched then+ insert (id, col1)+ values (t42.id, t42.col1)++++MERGE INTO TableA u++USING (SELECT b.Key1, b.ColB1, c.ColC1++FROM TableB b++INNER JOIN TableC c ON c.KeyC1 = b.KeyB1++) s++ON (u.KeyA1 = s.KeyA1)++WHEN MATCHED THEN++UPDATE SET u.ColA1 = s.ColB1, u.ColA2 = s.ColC1+++MERGE INTO Department +USING NewDept AS ND +ON nd.Department_Number = Department.+Department_Number +WHEN MATCHED THEN UPDATE +SET budget_amount = nd.Budget_Amount +WHEN NOT MATCHED THEN INSERT +VALUES +(nd.Department_Number, nd.Department_+Name, nd.Budget_Amount, + nd.Manager_Employee_Number);+++MERGE INTO Orders2 +USING Orders3 +ON ORDERS3.Order_Number = Orders2.+Order_Number +WHEN NOT MATCHED THEN INSERT +Orders3.order_number, Orders3.+invoice_number, + Orders3.customer_number, Orders3.+initial_order_date, + Orders3.invoice_date, Orders3.+invoice_amount);++MERGE INTO Orders2 +USING Orders3 +ON ORDERS3.Order_Number = Orders2.+Order_Number AND 1=0 +WHEN NOT MATCHED THEN INSERT +(Orders3.order_number, Orders3.invoice_number, + Orders3.customer_number, Orders3.+initial_order_date, + Orders3.invoice_date, Orders3.+invoice_amount);++MERGE INTO Department +USING NewDept AS ND +ON nd.Department_Number = Department.+Department_Number +WHEN MATCHED THEN UPDATE +SET budget_amount = nd.Budget_Amount +LOGGING ALL ERRORS WITH NO LIMIT;+++MERGE INTO Department +USING + (SELECT Department_Number,+department_name, + Budget_Amount, +Manager_Employee_Number + FROM NewDept + WHERE Department_Number IN +(SELECT Department_Number + FROM Employee)) AS m+ON m.Department_Number = Department.+Department_Number +WHEN MATCHED THEN UPDATE +SET budget_amount = m.Budget_Amount +WHEN NOT MATCHED THEN INSERT +(m.Department_Number, m.Department_+Name, m.Budget_Amount, +m.Manager_Employee_Number) +LOGGING ALL ERRORS WITH NO LIMIT;++ +MERGE INTO Customers AS c+USING Moved AS m+ ON m.SSN = c.SSN+WHEN MATCHED+THEN UPDATE+SET Street = m.Street,+ HouseNo = m.HouseNo,+ City = m.City;++MERGE INTO CentralOfficeAccounts AS C -- Target+USING BranchOfficeAccounts AS B -- Source+ ON C.account_nbr = B.account_nbr+WHEN MATCHED THEN -- On match update+ UPDATE SET C.company_name = B.company_name,+ C.primary_contact = B.primary_contact,+ C.contact_phone = B.contact_phone+WHEN NOT MATCHED THEN -- Add missing+ INSERT (account_nbr, company_name, primary_contact, contact_phone)+ VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);+ +SELECT account_nbr, company_name, primary_contact, contact_phone +FROM CentralOfficeAccounts;++++MERGE INTO CentralOfficeAccounts AS C -- Target+USING BranchOfficeAccounts AS B -- Source+ ON C.account_nbr = B.account_nbr+WHEN MATCHED -- On match update+ AND (C.company_name <> B.company_name -- Additional search conditions+ OR C.primary_contact <> B.primary_contact+ OR C.contact_phone <> B.contact_phone) THEN + UPDATE SET C.company_name = B.company_name,+ C.primary_contact = B.primary_contact,+ C.contact_phone = B.contact_phone+WHEN NOT MATCHED THEN -- Add missing+ INSERT (account_nbr, company_name, primary_contact, contact_phone)+ VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);++++MERGE INTO CentralOfficeAccounts AS C -- Target+USING BranchOfficeAccounts AS B -- Source+ ON C.account_nbr = B.account_nbr+WHEN MATCHED -- On match update+ AND (C.company_name <> B.company_name -- Additional search conditions+ OR C.primary_contact <> B.primary_contact+ OR C.contact_phone <> B.contact_phone) THEN + UPDATE SET C.company_name = B.company_name,+ C.primary_contact = B.primary_contact,+ C.contact_phone = B.contact_phone+WHEN NOT MATCHED THEN -- Add missing+ INSERT (account_nbr, company_name, primary_contact, contact_phone)+ VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone)+WHEN SOURCE NOT MATCHED THEN -- Delete missing from source+ DELETE;+ +SELECT account_nbr, company_name, primary_contact, contact_phone +FROM CentralOfficeAccounts; +++++<merge correlation name> ::=+ <correlation name>++<merge operation specification> ::=+ <merge when clause>...++<merge when clause> ::=+ <merge when matched clause>+ | <merge when not matched clause>++<merge when matched clause> ::=+ WHEN MATCHED [ AND <search condition> ]+ THEN <merge update or delete specification>++<merge update or delete specification> ::=+ <merge update specification>+ | <merge delete specification>++<merge when not matched clause> ::=+ WHEN NOT MATCHED [ AND <search condition> ]+ THEN <merge insert specification>++<merge update specification> ::=+ UPDATE SET <set clause list>++<merge delete specification> ::=+ DELETE++<merge insert specification> ::=+ INSERT [ <left paren> <insert column list> <right paren> ]+ [ <override clause> ]+ VALUES <merge insert value list>++<merge insert value list> ::=+ <left paren>+ <merge insert value element> [ { <comma> <merge insert value element> }... ]+ <right paren>++<merge insert value element> ::=+ <value expression>+ | <contextually typed value specification>++14.13 <update statement: positioned>++<updatestatement: positioned> ::=+ UPDATE <target table> [ [ AS ] <correlation name> ]+ SET <set clause list>+ WHERE CURRENT OF <cursor name>++14.14 <update statement: searched>++<update statement: searched> ::=+ UPDATE <target table>+ [ FOR PORTION OF <application time period name>+ FROM <point in time 1> TO <point in time 2> ]+ [ [ AS ] <correlation name> ]+ SET <set clause list>+ [ WHERE <search condition> ]+-}+++ ,(TestStatement ansi2011 "update t set a=b"+ $ Update [Name Nothing "t"] Nothing+ [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)++ ,(TestStatement ansi2011 "update t set a=b, c=5"+ $ Update [Name Nothing "t"] Nothing+ [Set [Name Nothing "a"] (Iden [Name Nothing "b"])+ ,Set [Name Nothing "c"] (NumLit "5")] Nothing)+++ ,(TestStatement ansi2011 "update t set a=b where a>5"+ $ Update [Name Nothing "t"] Nothing+ [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]+ $ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))+++ ,(TestStatement ansi2011 "update t as u set a=b where u.a>5"+ $ Update [Name Nothing "t"] (Just $ Name Nothing "u")+ [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]+ $ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"])+ [Name Nothing ">"] (NumLit "5"))++ ,(TestStatement ansi2011 "update t set (a,b)=(3,5)"+ $ Update [Name Nothing "t"] Nothing+ [SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]+ [NumLit "3", NumLit "5"]] Nothing)++++{-+14.15 <set clause list>++<set clause list> ::=+ <set clause> [ { <comma> <set clause> }... ]++<set clause> ::=+ <multiple column assignment>+ | <set target> <equals operator> <update source>++<set target> ::=+ <update target>+ | <mutated set clause>++<multiple column assignment> ::=+ <set target list> <equals operator> <assigned row>++<set target list> ::=+ <left paren> <set target> [ { <comma> <set target> }... ] <right paren>++<assigned row> ::=+ <contextually typed row value expression>++<update target> ::=+ <object column>+ | <object column>+ <left bracket or trigraph> <simple value specification> <right bracket or trigraph>++<object column> ::=+ <column name>++<mutated set clause> ::=+ <mutated target> <period> <method name>++<mutated target> ::=+ <object column>+ | <mutated set clause>++<update source> ::=+ <value expression>+ | <contextually typed value specification>++14.16 <temporary table declaration>++<temporary table declaration> ::=+ DECLARE LOCAL TEMPORARY TABLE <table name> <table element list>+ [ ON COMMIT <table commit action> ROWS ]++declare local temporary table t (a int) [on commit {preserve | delete} rows]++14.17 <free locator statement>++<free locator statement> ::=+ FREE LOCATOR <locator reference> [ { <comma> <locator reference> }... ]++<locator reference> ::=+ <host parameter name>+ | <embedded variable name>+ | <dynamic parameter specification>++14.18 <hold locator statement>++<hold locator statement> ::=+ HOLD LOCATOR <locator reference> [ { <comma> <locator reference> }... ]+-}+++ ]
+ tests/Language/SQL/SimpleSQL/SQL2011Queries.hs view
@@ -0,0 +1,4520 @@++{-+This file goes through the grammar for SQL 2011 queries (using the+draft standard).++There are other files which cover some of the other sections from SQL+2011 (ddl, non-query dml, etc).++Possible sections not in the todo which could+be covered:++13 modules+16 control statements+18 connection management+20 dynamic+22 direct+23 diagnostics++procedural sql++some of the main areas being left for now:+temporal and versioning stuff+modules+ref stuff+todo: finish this list++++The goal is to create some example tests for each bit of grammar, with+some areas getting more comprehensive coverage tests, and also to note+which parts aren't currently supported.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.SQL2011Queries (sql2011QueryTests) where+import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++import Data.Text (Text)++sql2011QueryTests :: TestItem+sql2011QueryTests = Group "sql 2011 query tests"+ [literals+ ,identifiers+ ,typeNameTests+ ,fieldDefinition+ ,valueExpressions+ ,queryExpressions+ ,scalarSubquery+ ,predicates+ ,intervalQualifier+ ,collateClause+ ,aggregateFunction+ ,sortSpecificationList+ ]++{-+= 5 Lexical elements++The tests don't make direct use of these definitions.++== 5.1 <SQL terminal character>++Function++Define the terminal symbols of the SQL language and the elements of+strings.++<SQL terminal character> ::= <SQL language character>++<SQL language character> ::=+ <simple Latin letter>+ | <digit>+ | <SQL special character>++<simple Latin letter> ::=+ <simple Latin upper case letter>+ | <simple Latin lower case letter>++<simple Latin upper case letter> ::=+ A | B | C | D | E | F | G | H | I | J | K | L | M | N | O+ | P | Q | R | S | T | U | V | W | X | Y | Z++<simple Latin lower case letter> ::=+ a | b | c | d | e | f | g | h | i | j | k | l | m | n | o+ | p | q | r | s | t | u | v | w | x | y | z++<digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9++<SQL special character> ::=+ <space>+ | <double quote>+ | <percent>+ | <ampersand>+ | <quote>+ | <left paren>+ | <right paren>+ | <asterisk>+ | <plus sign>+ | <comma>+ | <minus sign>+ | <period>+ | <solidus>+ | <colon>+ | <semicolon>+ | <less than operator>+ | <equals operator>+ | <greater than operator>+ | <question mark>+ | <left bracket>+ | <right bracket>+ | <circumflex>+ | <underscore>+ | <vertical bar>+ | <left brace>+ | <right brace>++<space> ::= !! See the Syntax Rules.++<double quote> ::= "++<percent> ::= %++<ampersand> ::= &++<quote> ::= '++<left paren> ::= (++<right paren> ::= )++<asterisk> ::= *++<plus sign> ::= +++<comma> ::= ,++<minus sign> ::= -++<period> ::= .++<solidus> ::= /++<reverse solidus> ::= \++<colon> ::= :++<semicolon> ::= ;++<less than operator> ::= <++<equals operator> ::= =++<greater than operator> ::= >++<question mark> ::= ?++<left bracket or trigraph> ::= <left bracket> | <left bracket trigraph>++<right bracket or trigraph> ::= <right bracket> | <right bracket trigraph>++<left bracket> ::= [++<left bracket trigraph> ::= ??(++<right bracket> ::= ]++<right bracket trigraph> ::= ??)++<circumflex> ::= ^++<underscore> ::= _++<vertical bar> ::= |++<left brace> ::= {++<right brace> ::= }++== 5.2 <token> and <separator>++Function++Specify lexical units (tokens and separators) that participate in SQL+language.++<token> ::= <nondelimiter token> | <delimiter token>++<nondelimiter token> ::=+ <regular identifier>+ | <key word>+ | <unsigned numeric literal>+ | <national character string literal>+ | <binary string literal>+ | <large object length token>+ | <Unicode delimited identifier>+ | <Unicode character string literal>+ | <SQL language identifier>++<regular identifier> ::= <identifier body>++<identifier body> ::= <identifier start> [ <identifier part>... ]++<identifier part> ::= <identifier start> | <identifier extend>++<identifier start> ::= !! See the Syntax Rules.++<identifier extend> ::= !! See the Syntax Rules.++<large object length token> ::= <digit>... <multiplier>++<multiplier> ::= K | M | G | T | P++<delimited identifier> ::=+ <double quote> <delimited identifier body> <double quote>++<delimited identifier body> ::= <delimited identifier part>...++<delimited identifier part> ::=+ <nondoublequote character>+ | <doublequote symbol>++<Unicode delimited identifier> ::=+ U <ampersand> <double quote> <Unicode delimiter body> <double quote>+ <Unicode escape specifier>++<Unicode escape specifier> ::=+ [ UESCAPE <quote> <Unicode escape character> <quote> ]++<Unicode delimiter body> ::= <Unicode identifier part>...++<Unicode identifier part> ::=+ <delimited identifier part>+ | <Unicode escape value>++<Unicode escape value> ::=+ <Unicode 4 digit escape value>+ | <Unicode 6 digit escape value>+ | <Unicode character escape value>++<Unicode 4 digit escape value> ::=+ <Unicode escape character> <hexit> <hexit> <hexit> <hexit>++<Unicode 6 digit escape value> ::=+ <Unicode escape character> <plus sign>+ <hexit> <hexit> <hexit> <hexit> <hexit> <hexit>++<Unicode character escape value> ::=+ <Unicode escape character> <Unicode escape character>++<Unicode escape character> ::= !! See the Syntax Rules.++<nondoublequote character> ::= !! See the Syntax Rules.++<doublequote symbol> ::= ""!! two consecutive double quote characters++<delimiter token> ::=+ <character string literal>+ | <date string>+ | <time string>+ | <timestamp string>+ | <interval string>+ | <delimited identifier>+ | <SQL special character>+ | <not equals operator>+ | <greater than or equals operator>+ | <less than or equals operator>+ | <concatenation operator>+ | <right arrow>+ | <left bracket trigraph>+ | <right bracket trigraph>+ | <double colon>+ | <double period>+ | <named argument assignment token>++<not equals operator> ::= <>++<greater than or equals operator> ::= >=++<less than or equals operator> ::= <=++<concatenation operator> ::= ||++<right arrow> ::= ->++<double colon> ::= ::++<double period> ::= ..++<named argument assignment token> ::= =>++<separator> ::= { <comment> | <white space> }...++<white space> ::= !! See the Syntax Rules.++<comment> ::= <simple comment> | <bracketed comment>++<simple comment> ::=+ <simple comment introducer> [ <comment character>... ] <newline>++<simple comment introducer> ::= <minus sign> <minus sign>++<bracketed comment> ::=+ <bracketed comment introducer>+ <bracketed comment contents>+ <bracketed comment terminator>++<bracketed comment introducer> ::= /*++<bracketed comment terminator> ::= */++<bracketed comment contents> ::=+ [ { <comment character> | <separator> }... ]!! See the Syntax Rules.++<comment character> ::= <nonquote character> | <quote>++<newline> ::= !! See the Syntax Rules.++<key word> ::= <reserved word> | <non-reserved word>++<non-reserved word> ::=+ A | ABSOLUTE | ACTION | ADA | ADD | ADMIN | AFTER | ALWAYS | ASC+ | ASSERTION | ASSIGNMENT | ATTRIBUTE | ATTRIBUTES++ | BEFORE | BERNOULLI | BREADTH++ | C | CASCADE | CATALOG | CATALOG_NAME | CHAIN | CHARACTER_SET_CATALOG+ | CHARACTER_SET_NAME | CHARACTER_SET_SCHEMA | CHARACTERISTICS | CHARACTERS+ | CLASS_ORIGIN | COBOL | COLLATION | COLLATION_CATALOG | COLLATION_NAME | COLLATION_SCHEMA+ | COLUMN_NAME | COMMAND_FUNCTION | COMMAND_FUNCTION_CODE | COMMITTED+ | CONDITION_NUMBER | CONNECTION | CONNECTION_NAME | CONSTRAINT_CATALOG | CONSTRAINT_NAME+ | CONSTRAINT_SCHEMA | CONSTRAINTS | CONSTRUCTOR | CONTINUE | CURSOR_NAME++ | DATA | DATETIME_INTERVAL_CODE | DATETIME_INTERVAL_PRECISION | DEFAULTS | DEFERRABLE+ | DEFERRED | DEFINED | DEFINER | DEGREE | DEPTH | DERIVED | DESC | DESCRIPTOR+ | DIAGNOSTICS | DISPATCH | DOMAIN | DYNAMIC_FUNCTION | DYNAMIC_FUNCTION_CODE++ | ENFORCED | EXCLUDE | EXCLUDING | EXPRESSION++ | FINAL | FIRST | FLAG | FOLLOWING | FORTRAN | FOUND++ | G | GENERAL | GENERATED | GO | GOTO | GRANTED++ | HIERARCHY++ | IGNORE | IMMEDIATE | IMMEDIATELY | IMPLEMENTATION | INCLUDING | INCREMENT | INITIALLY+ | INPUT | INSTANCE | INSTANTIABLE | INSTEAD | INVOKER | ISOLATION++ | K | KEY | KEY_MEMBER | KEY_TYPE++ | LAST | LENGTH | LEVEL | LOCATOR++ | M | MAP | MATCHED | MAXVALUE | MESSAGE_LENGTH | MESSAGE_OCTET_LENGTH+ | MESSAGE_TEXT | MINVALUE | MORE | MUMPS++ | NAME | NAMES | NESTING | NEXT | NFC | NFD | NFKC | NFKD+ | NORMALIZED | NULLABLE | NULLS | NUMBER++ | OBJECT | OCTETS | OPTION | OPTIONS | ORDERING | ORDINALITY | OTHERS+ | OUTPUT | OVERRIDING++ | P | PAD | PARAMETER_MODE | PARAMETER_NAME | PARAMETER_ORDINAL_POSITION+ | PARAMETER_SPECIFIC_CATALOG | PARAMETER_SPECIFIC_NAME | PARAMETER_SPECIFIC_SCHEMA+ | PARTIAL | PASCAL | PATH | PLACING | PLI | PRECEDING | PRESERVE | PRIOR+ | PRIVILEGES | PUBLIC++ | READ | RELATIVE | REPEATABLE | RESPECT | RESTART | RESTRICT | RETURNED_CARDINALITY+ | RETURNED_LENGTH | RETURNED_OCTET_LENGTH | RETURNED_SQLSTATE | ROLE+ | ROUTINE | ROUTINE_CATALOG | ROUTINE_NAME | ROUTINE_SCHEMA | ROW_COUNT++ | SCALE | SCHEMA | SCHEMA_NAME | SCOPE_CATALOG | SCOPE_NAME | SCOPE_SCHEMA+ | SECTION | SECURITY | SELF | SEQUENCE | SERIALIZABLE | SERVER_NAME | SESSION+ | SETS | SIMPLE | SIZE | SOURCE | SPACE | SPECIFIC_NAME | STATE | STATEMENT+ | STRUCTURE | STYLE | SUBCLASS_ORIGIN++ | T | TABLE_NAME | TEMPORARY | TIES | TOP_LEVEL_COUNT | TRANSACTION+ | TRANSACTION_ACTIVE | TRANSACTIONS_COMMITTED | TRANSACTIONS_ROLLED_BACK+ | TRANSFORM | TRANSFORMS | TRIGGER_CATALOG | TRIGGER_NAME | TRIGGER_SCHEMA | TYPE++ | UNBOUNDED | UNCOMMITTED | UNDER | UNNAMED | USAGE | USER_DEFINED_TYPE_CATALOG+ | USER_DEFINED_TYPE_CODE | USER_DEFINED_TYPE_NAME | USER_DEFINED_TYPE_SCHEMA++ | VIEW++ | WORK | WRITE++ | ZONE++<reserved word> ::=+ ABS | ALL | ALLOCATE | ALTER | AND | ANY | ARE | ARRAY | ARRAY_AGG+ | ARRAY_MAX_CARDINALITY | AS | ASENSITIVE | ASYMMETRIC | AT | ATOMIC | AUTHORIZATION+ | AVG++ | BEGIN | BEGIN_FRAME | BEGIN_PARTITION | BETWEEN | BIGINT | BINARY+ | BLOB | BOOLEAN | BOTH | BY++ | CALL | CALLED | CARDINALITY | CASCADED | CASE | CAST | CEIL | CEILING+ | CHAR | CHAR_LENGTH | CHARACTER | CHARACTER_LENGTH | CHECK | CLOB | CLOSE+ | COALESCE | COLLATE | COLLECT | COLUMN | COMMIT | CONDITION | CONNECT+ | CONSTRAINT | CONTAINS | CONVERT | CORR | CORRESPONDING | COUNT | COVAR_POP+ | COVAR_SAMP | CREATE | CROSS | CUBE | CUME_DIST | CURRENT | CURRENT_CATALOG+ | CURRENT_DATE | CURRENT_DEFAULT_TRANSFORM_GROUP | CURRENT_PATH | CURRENT_ROLE+ | CURRENT_ROW | CURRENT_SCHEMA | CURRENT_TIME | CURRENT_TIMESTAMP+ | CURRENT_TRANSFORM_GROUP_FOR_TYPE | CURRENT_USER | CURSOR | CYCLE++ | DATE | DAY | DEALLOCATE | DEC | DECIMAL | DECLARE | DEFAULT | DELETE+ | DENSE_RANK | DEREF | DESCRIBE | DETERMINISTIC | DISCONNECT | DISTINCT+ | DOUBLE | DROP | DYNAMIC++ | EACH | ELEMENT | ELSE | END | END_FRAME | END_PARTITION | END-EXEC+ | EQUALS | ESCAPE | EVERY | EXCEPT | EXEC | EXECUTE | EXISTS | EXP+ | EXTERNAL | EXTRACT++ | FALSE | FETCH | FILTER | FIRST_VALUE | FLOAT | FLOOR | FOR | FOREIGN+ | FRAME_ROW | FREE | FROM | FULL | FUNCTION | FUSION++ | GET | GLOBAL | GRANT | GROUP | GROUPING | GROUPS++ | HAVING | HOLD | HOUR++ | IDENTITY | IN | INDICATOR | INNER | INOUT | INSENSITIVE | INSERT+ | INT | INTEGER | INTERSECT | INTERSECTION | INTERVAL | INTO | IS++ | JOIN++ | LAG | LANGUAGE | LARGE | LAST_VALUE | LATERAL | LEAD | LEADING | LEFT+ | LIKE | LIKE_REGEX | LN | LOCAL | LOCALTIME | LOCALTIMESTAMP | LOWER++ | MATCH | MAX | MEMBER | MERGE | METHOD | MIN | MINUTE+ | MOD | MODIFIES | MODULE | MONTH | MULTISET++ | NATIONAL | NATURAL | NCHAR | NCLOB | NEW | NO | NONE | NORMALIZE | NOT+ | NTH_VALUE | NTILE | NULL | NULLIF | NUMERIC++ | OCTET_LENGTH | OCCURRENCES_REGEX | OF | OFFSET | OLD | ON | ONLY | OPEN+ | OR | ORDER | OUT | OUTER | OVER | OVERLAPS | OVERLAY++ | PARAMETER | PARTITION | PERCENT | PERCENT_RANK | PERCENTILE_CONT+ | PERCENTILE_DISC | PERIOD | PORTION | POSITION | POSITION_REGEX | POWER | PRECEDES+ | PRECISION | PREPARE | PRIMARY | PROCEDURE++ | RANGE | RANK | READS | REAL | RECURSIVE | REF | REFERENCES | REFERENCING+ | REGR_AVGX | REGR_AVGY | REGR_COUNT | REGR_INTERCEPT | REGR_R2 | REGR_SLOPE+ | REGR_SXX | REGR_SXY | REGR_SYY | RELEASE | RESULT | RETURN | RETURNS+ | REVOKE | RIGHT | ROLLBACK | ROLLUP | ROW | ROW_NUMBER | ROWS++ | SAVEPOINT | SCOPE | SCROLL | SEARCH | SECOND | SELECT+ | SENSITIVE | SESSION_USER | SET | SIMILAR | SMALLINT | SOME | SPECIFIC+ | SPECIFICTYPE | SQL | SQLEXCEPTION | SQLSTATE | SQLWARNING | SQRT | START+ | STATIC | STDDEV_POP | STDDEV_SAMP | SUBMULTISET | SUBSTRING | SUBSTRING_REGEX+ | SUCCEEDS | SUM | SYMMETRIC | SYSTEM | SYSTEM_TIME | SYSTEM_USER++ | TABLE | TABLESAMPLE | THEN | TIME | TIMESTAMP | TIMEZONE_HOUR | TIMEZONE_MINUTE+ | TO | TRAILING | TRANSLATE | TRANSLATE_REGEX | TRANSLATION | TREAT+ | TRIGGER | TRUNCATE | TRIM | TRIM_ARRAY | TRUE++ | UESCAPE | UNION | UNIQUE | UNKNOWN | UNNEST | UPDATE | UPPER | USER | USING++ | VALUE | VALUES | VALUE_OF | VAR_POP | VAR_SAMP | VARBINARY+ | VARCHAR | VARYING | VERSIONING++ | WHEN | WHENEVER | WHERE | WIDTH_BUCKET | WINDOW | WITH | WITHIN | WITHOUT++ | YEAR++== 5.3 <literal>++Function+Specify a non-null value.+-}++literals :: TestItem+literals = Group "literals"+ [numericLiterals,generalLiterals]++{-+<literal> ::= <signed numeric literal> | <general literal>++<unsigned literal> ::= <unsigned numeric literal> | <general literal>++<general literal> ::=+ <character string literal>+ | <national character string literal>+ | <Unicode character string literal>+ | <binary string literal>+ | <datetime literal>+ | <interval literal>+ | <boolean literal>+-}++generalLiterals :: TestItem+generalLiterals = Group "general literals"+ [characterStringLiterals+ ,nationalCharacterStringLiterals+ ,unicodeCharacterStringLiterals+ ,binaryStringLiterals+ ,dateTimeLiterals+ ,intervalLiterals+ ,booleanLiterals]++{-+<character string literal> ::=+ [ <introducer> <character set specification> ]+ <quote> [ <character representation>... ] <quote>+ [ { <separator> <quote> [ <character representation>... ] <quote> }... ]++<introducer> ::= <underscore>++<character representation> ::= <nonquote character> | <quote symbol>++<nonquote character> ::= !! See the Syntax Rules.++<quote symbol> ::= <quote> <quote>+-}++characterStringLiterals :: TestItem+characterStringLiterals = Group "character string literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("'a regular string literal'"+ ,StringLit "'" "'" "a regular string literal")+ ,("'something' ' some more' 'and more'"+ ,StringLit "'" "'" "something some moreand more")+ ,("'something' \n ' some more' \t 'and more'"+ ,StringLit "'" "'" "something some moreand more")+ ,("'something' -- a comment\n ' some more' /*another comment*/ 'and more'"+ ,StringLit "'" "'" "something some moreand more")+ ,("'a quote: '', stuff'"+ ,StringLit "'" "'" "a quote: '', stuff")+ ,("''"+ ,StringLit "'" "'" "")++{-+I'm not sure how this should work. Maybe the parser should reject non+ascii characters in strings and identifiers unless the current SQL+character set allows them.+-}++ ,("_francais 'français'"+ ,TypedLit (TypeName [Name Nothing "_francais"]) "français")+ ]++{-+<national character string literal> ::=+ N <quote> [ <character representation>... ]+ <quote> [ { <separator> <quote> [ <character representation>... ] <quote> }... ]+-}++nationalCharacterStringLiterals :: TestItem+nationalCharacterStringLiterals = Group "national character string literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("N'something'", StringLit "N'" "'" "something")+ ,("n'something'", StringLit "n'" "'" "something")+ ]++{-+<Unicode character string literal> ::=+ [ <introducer> <character set specification> ]+ U <ampersand> <quote> [ <Unicode representation>... ] <quote>+ [ { <separator> <quote> [ <Unicode representation>... ] <quote> }... ]+ <Unicode escape specifier>++<Unicode representation> ::=+ <character representation>+ | <Unicode escape value>+-}++unicodeCharacterStringLiterals :: TestItem+unicodeCharacterStringLiterals = Group "unicode character string literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("U&'something'", StringLit "U&'" "'" "something")+ {-,("u&'something' escape ="+ ,Escape (StringLit "u&'" "'" "something") '=')+ ,("u&'something' uescape ="+ ,UEscape (StringLit "u&'" "'" "something") '=')-}+ ]++{-+TODO: unicode escape++<binary string literal> ::=+ X <quote> [ <space>... ] [ { <hexit> [ <space>... ] <hexit> [ <space>... ] }... ] <quote>+ [ { <separator> <quote> [ <space>... ] [ { <hexit> [ <space>... ]+ <hexit> [ <space>... ] }... ] <quote> }... ]++<hexit> ::= <digit> | A | B | C | D | E | F | a | b | c | d | e | f+-}++binaryStringLiterals :: TestItem+binaryStringLiterals = Group "binary string literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [--("B'101010'", CSStringLit "B" "101010")+ ("X'7f7f7f'", StringLit "X'" "'" "7f7f7f")+ --,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z')+ ]++{-+<signed numeric literal> ::= [ <sign> ] <unsigned numeric literal>++<unsigned numeric literal> ::=+ <exact numeric literal>+ | <approximate numeric literal>++<exact numeric literal> ::=+ <unsigned integer> [ <period> [ <unsigned integer> ] ]+ | <period> <unsigned integer>++<sign> ::= <plus sign> | <minus sign>++<approximate numeric literal> ::= <mantissa> E <exponent>++<mantissa> ::= <exact numeric literal>++<exponent> ::= <signed integer>++<signed integer> ::= [ <sign> ] <unsigned integer>++<unsigned integer> ::= <digit>...+-}++numericLiterals :: TestItem+numericLiterals = Group "numeric literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("11", NumLit "11")+ ,("11.11", NumLit "11.11")++ ,("11E23", NumLit "11E23")+ ,("11E+23", NumLit "11E+23")+ ,("11E-23", NumLit "11E-23")++ ,("11.11E23", NumLit "11.11E23")+ ,("11.11E+23", NumLit "11.11E+23")+ ,("11.11E-23", NumLit "11.11E-23")++ ,("+11E23", PrefixOp [Name Nothing "+"] $ NumLit "11E23")+ ,("+11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11E+23")+ ,("+11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11E-23")+ ,("+11.11E23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E23")+ ,("+11.11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23")+ ,("+11.11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23")++ ,("-11E23", PrefixOp [Name Nothing "-"] $ NumLit "11E23")+ ,("-11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11E+23")+ ,("-11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11E-23")+ ,("-11.11E23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E23")+ ,("-11.11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23")+ ,("-11.11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23")++ ,("11.11e23", NumLit "11.11e23")++ ]++{-+<datetime literal> ::= <date literal> | <time literal> | <timestamp literal>++<date literal> ::= DATE <date string>++<time literal> ::= TIME <time string>++<timestamp literal> ::= TIMESTAMP <timestamp string>++<date string> ::= <quote> <unquoted date string> <quote>++<time string> ::= <quote> <unquoted time string> <quote>++<timestamp string> ::= <quote> <unquoted timestamp string> <quote>++<time zone interval> ::= <sign> <hours value> <colon> <minutes value>++<date value> ::=+ <years value> <minus sign> <months value> <minus sign> <days value>++<time value> ::= <hours value> <colon> <minutes value> <colon> <seconds value>+-}++dateTimeLiterals :: TestItem+dateTimeLiterals = Group "datetime literals"+ [-- TODO: datetime literals+ ]++{-+<interval literal> ::=+ INTERVAL [ <sign> ] <interval string> <interval qualifier>++<interval string> ::= <quote> <unquoted interval string> <quote>++<unquoted date string> ::= <date value>++<unquoted time string> ::= <time value> [ <time zone interval> ]++<unquoted timestamp string> ::=+ <unquoted date string> <space> <unquoted time string>++<unquoted interval string> ::=+ [ <sign> ] { <year-month literal> | <day-time literal> }++<year-month literal> ::=+ <years value> [ <minus sign> <months value> ]+ | <months value>++<day-time literal> ::= <day-time interval> | <time interval>++<day-time interval> ::=+ <days value> [ <space> <hours value> [ <colon> <minutes value>+ [ <colon> <seconds value> ] ] ]++<time interval> ::=+ <hours value> [ <colon> <minutes value> [ <colon> <seconds value> ] ]+ | <minutes value> [ <colon> <seconds value> ]+ | <seconds value>++<years value> ::= <datetime value>++<months value> ::= <datetime value>++<days value> ::= <datetime value>++<hours value> ::= <datetime value>++<minutes value> ::= <datetime value>++<seconds value> ::= <seconds integer value> [ <period> [ <seconds fraction> ] ]++<seconds integer value> ::= <unsigned integer>++<seconds fraction> ::= <unsigned integer>++<datetime value> ::= <unsigned integer>+-}++intervalLiterals :: TestItem+intervalLiterals = Group "intervalLiterals literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("interval '1'", TypedLit (TypeName [Name Nothing "interval"]) "1")+ ,("interval '1' day"+ ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)+ ,("interval '1' day(3)"+ ,IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing)+ ,("interval + '1' day(3)"+ ,IntervalLit (Just Plus) "1" (Itf "day" $ Just (3,Nothing)) Nothing)+ ,("interval - '1' second(2,2)"+ ,IntervalLit (Just Minus) "1" (Itf "second" $ Just (2,Just 2)) Nothing)+ ,("interval '1' year to month"+ ,IntervalLit Nothing "1" (Itf "year" Nothing)+ (Just $ Itf "month" Nothing))++ ,("interval '1' year(4) to second(2,3) "+ ,IntervalLit Nothing "1" (Itf "year" $ Just (4,Nothing))+ (Just $ Itf "second" $ Just (2, Just 3)))+ ]++-- <boolean literal> ::= TRUE | FALSE | UNKNOWN++booleanLiterals :: TestItem+booleanLiterals = Group "boolean literals"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("true", Iden [Name Nothing "true"])+ ,("false", Iden [Name Nothing "false"])+ ,("unknown", Iden [Name Nothing "unknown"])+ ]++{-+== 5.4 Names and identifiers++Function+Specify names.++<identifier> ::= <actual identifier>++<actual identifier> ::=+ <regular identifier>+ | <delimited identifier>+ | <Unicode delimited identifier>+-}++identifiers :: TestItem+identifiers = Group "identifiers"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("test",Iden [Name Nothing "test"])+ ,("_test",Iden [Name Nothing "_test"])+ ,("t1",Iden [Name Nothing "t1"])+ ,("a.b",Iden [Name Nothing "a", Name Nothing "b"])+ ,("a.b.c",Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"])+ ,("\"quoted iden\"", Iden [Name (Just ("\"","\"")) "quoted iden"])+ ,("\"quoted \"\" iden\"", Iden [Name (Just ("\"","\"")) "quoted \"\" iden"])+ ,("U&\"quoted iden\"", Iden [Name (Just ("U&\"","\"")) "quoted iden"])+ ,("U&\"quoted \"\" iden\"", Iden [Name (Just ("U&\"","\"")) "quoted \"\" iden"])+ ]++{-+TODO: more identifiers, e.g. unicode escapes?, mixed quoted/unquoted+chains++TODO: review below stuff for exact rules++<SQL language identifier> ::=+ <SQL language identifier start> [ <SQL language identifier part>... ]++<SQL language identifier start> ::= <simple Latin letter>++<SQL language identifier part> ::=+ <simple Latin letter>+ | <digit>+ | <underscore>++<authorization identifier> ::= <role name> | <user identifier>++<table name> ::= <local or schema qualified name>++<domain name> ::= <schema qualified name>++<schema name> ::= [ <catalog name> <period> ] <unqualified schema name>++<unqualified schema name> ::= <identifier>++<catalog name> ::= <identifier>++<schema qualified name> ::= [ <schema name> <period> ] <qualified identifier>++<local or schema qualified name> ::=+ [ <local or schema qualifier> <period> ] <qualified identifier>++<local or schema qualifier> ::= <schema name> | <local qualifier>++<qualified identifier> ::= <identifier>++<column name> ::= <identifier>++<correlation name> ::= <identifier>++<query name> ::= <identifier>++<SQL-client module name> ::= <identifier>++<procedure name> ::= <identifier>++<schema qualified routine name> ::= <schema qualified name>++<method name> ::= <identifier>++<specific name> ::= <schema qualified name>++<cursor name> ::= <local qualified name>++<local qualified name> ::=+ [ <local qualifier> <period> ] <qualified identifier>++<local qualifier> ::= MODULE++<host parameter name> ::= <colon> <identifier>++<SQL parameter name> ::= <identifier>++<constraint name> ::= <schema qualified name>++<external routine name> ::= <identifier> | <character string literal>++<trigger name> ::= <schema qualified name>++<collation name> ::= <schema qualified name>++<character set name> ::= [ <schema name> <period> ] <SQL language identifier>++<transliteration name> ::= <schema qualified name>++<transcoding name> ::= <schema qualified name>++<schema-resolved user-defined type name> ::= <user-defined type name>++<user-defined type name> ::= [ <schema name> <period> ] <qualified identifier>++<attribute name> ::= <identifier>++<field name> ::= <identifier>++<savepoint name> ::= <identifier>++<sequence generator name> ::= <schema qualified name>++<role name> ::= <identifier>++<user identifier> ::= <identifier>++<connection name> ::= <simple value specification>++<SQL-server name> ::= <simple value specification>++<connection user name> ::= <simple value specification>++<SQL statement name> ::= <statement name> | <extended statement name>++<statement name> ::= <identifier>++<extended statement name> ::= [ <scope option> ] <simple value specification>++<dynamic cursor name> ::= <cursor name> | <extended cursor name>++<extended cursor name> ::= [ <scope option> ] <simple value specification>++<descriptor name> ::=+ <non-extended descriptor name>+ | <extended descriptor name>++<non-extended descriptor name> ::= <identifier>++<extended descriptor name> ::= [ <scope option> ] <simple value specification>++<scope option> ::= GLOBAL | LOCAL++<window name> ::= <identifier>++= 6 Scalar expressions++== 6.1 <data type>++Function+Specify a data type.++<data type> ::=+ <predefined type>+ | <row type>+ | <path-resolved user-defined type name>+ | <reference type>+ | <collection type>++<predefined type> ::=+ <character string type> [ CHARACTER SET <character set specification> ]+ [ <collate clause> ]+ | <national character string type> [ <collate clause> ]+ | <binary string type>+ | <numeric type>+ | <boolean type>+ | <datetime type>+ | <interval type>++<character string type> ::=+ CHARACTER [ <left paren> <character length> <right paren> ]+ | CHAR [ <left paren> <character length> <right paren> ]+ | CHARACTER VARYING <left paren> <character length> <right paren>+ | CHAR VARYING <left paren> <character length> <right paren>+ | VARCHAR <left paren> <character length> <right paren>+ | <character large object type>++<character large object type> ::=+ CHARACTER LARGE OBJECT [ <left paren> <character large object length> <right paren> ]+ | CHAR LARGE OBJECT [ <left paren> <character large object length> <right paren> ]+ | CLOB [ <left paren> <character large object length> <right paren> ]++<national character string type> ::=+ NATIONAL CHARACTER [ <left paren> <character length> <right paren> ]+ | NATIONAL CHAR [ <left paren> <character length> <right paren> ]+ | NCHAR [ <left paren> <character length> <right paren> ]+ | NATIONAL CHARACTER VARYING <left paren> <character length> <right paren>+ | NATIONAL CHAR VARYING <left paren> <character length> <right paren>+ | NCHAR VARYING <left paren> <character length> <right paren>+ | <national character large object type>++<national character large object type> ::=+ NATIONAL CHARACTER LARGE OBJECT [ <left paren> <character large object length> <right+ paren> ]+ | NCHAR LARGE OBJECT [ <left paren> <character large object length> <right paren> ]+ | NCLOB [ <left paren> <character large object length> <right paren> ]++<binary string type> ::=+ BINARY [ <left paren> <length> <right paren> ]+ | BINARY VARYING <left paren> <length> <right paren>+ | VARBINARY <left paren> <length> <right paren>+ | <binary large object string type>++<binary large object string type> ::=+ BINARY LARGE OBJECT [ <left paren> <large object length> <right paren> ]+ | BLOB [ <left paren> <large object length> <right paren> ]++<numeric type> ::= <exact numeric type> | <approximate numeric type>++<exact numeric type> ::=+ NUMERIC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+ | DECIMAL [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+ | DEC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+ | SMALLINT+ | INTEGER+ | INT+ | BIGINT++<approximate numeric type> ::=+ FLOAT [ <left paren> <precision> <right paren> ]+ | REAL+ | DOUBLE PRECISION++<length> ::= <unsigned integer>++<character length> ::= <length> [ <char length units> ]++<large object length> ::=+ <length> [ <multiplier> ]+ | <large object length token>++<character large object length> ::=+ <large object length> [ <char length units> ]++<char length units> ::= CHARACTERS | OCTETS++<precision> ::= <unsigned integer>++<scale> ::= <unsigned integer>++<boolean type> ::= BOOLEAN++<datetime type> ::=+ DATE+ | TIME [ <left paren> <time precision> <right paren> ] [ <with or without time zone> ]+ | TIMESTAMP [ <left paren> <timestamp precision> <right paren> ]+ [ <with or without time zone> ]++<with or without time zone> ::= WITH TIME ZONE | WITHOUT TIME ZONE++<time precision> ::= <time fractional seconds precision>++<timestamp precision> ::= <time fractional seconds precision>++<time fractional seconds precision> ::= <unsigned integer>++<interval type> ::= INTERVAL <interval qualifier>++<row type> ::= ROW <row type body>++<row type body> ::=+ <left paren> <field definition> [ { <comma> <field definition> }... ] <right paren>++<reference type> ::=+ REF <left paren> <referenced type> <right paren> [ <scope clause> ]++<scope clause> ::= SCOPE <table name>++<referenced type> ::= <path-resolved user-defined type name>++<path-resolved user-defined type name> ::= <user-defined type name>++<collection type> ::= <array type> | <multiset type>++<array type> ::=+ <data type> ARRAY+ [ <left bracket or trigraph> <maximum cardinality> <right bracket or trigraph> ]++<maximum cardinality> ::= <unsigned integer>++<multiset type> ::= <data type> MULTISET++TODO: below, add new stuff:+review the length syntaxes+binary, binary varying/varbinary+new multipliers++create a list of type name variations:+-}++typeNames :: ([(Text,TypeName)],[(Text,TypeName)])+typeNames =+ (basicTypes, concatMap makeArray basicTypes+ <> map makeMultiset basicTypes)+ where+ makeArray (s,t) = [(s <> " array", ArrayTypeName t Nothing)+ ,(s <> " array[5]", ArrayTypeName t (Just 5))]+ makeMultiset (s,t) = (s <> " multiset", MultisetTypeName t)+ basicTypes :: [(Text, TypeName)]+ basicTypes =+ -- example of every standard type name+ map (\t -> (t,TypeName [Name Nothing t]))+ ["binary"+ ,"binary varying"+ ,"character"+ ,"char"+ ,"character varying"+ ,"char varying"+ ,"varbinary"+ ,"varchar"+ ,"character large object"+ ,"char large object"+ ,"clob"+ ,"national character"+ ,"national char"+ ,"nchar"+ ,"national character varying"+ ,"national char varying"+ ,"nchar varying"+ ,"national character large object"+ ,"nchar large object"+ ,"nclob"+ ,"binary large object"+ ,"blob"+ ,"numeric"+ ,"decimal"+ ,"dec"+ ,"smallint"+ ,"integer"+ ,"int"+ ,"bigint"+ ,"float"+ ,"real"+ ,"double precision"+ ,"boolean"+ ,"date"+ ,"time"+ ,"timestamp"]+ --interval -- not allowed without interval qualifier+ --row -- not allowed without row type body+ -- array -- not allowed on own+ -- multiset -- not allowed on own++ <>+ [-- 1 single prec + 1 with multiname+ ("char(5)", PrecTypeName [Name Nothing "char"] 5)+ ,("char varying(5)", PrecTypeName [Name Nothing "char varying"] 5)+ -- 1 scale+ ,("decimal(15,2)", PrecScaleTypeName [Name Nothing "decimal"] 15 2)+ ,("char(3 octets)"+ ,PrecLengthTypeName [Name Nothing "char"] 3 Nothing (Just PrecOctets))+ ,("varchar(50 characters)"+ ,PrecLengthTypeName [Name Nothing "varchar"] 50 Nothing (Just PrecCharacters))+ -- lob prec + with multiname+ ,("blob(3M)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecM) Nothing)+ ,("blob(3T)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecT) Nothing)+ ,("blob(3P)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecP) Nothing)+ ,("blob(4M characters) "+ ,PrecLengthTypeName [Name Nothing "blob"] 4 (Just PrecM) (Just PrecCharacters))+ ,("blob(6G octets) "+ ,PrecLengthTypeName [Name Nothing "blob"] 6 (Just PrecG) (Just PrecOctets))+ ,("national character large object(7K) "+ ,PrecLengthTypeName [Name Nothing "national character large object"]+ 7 (Just PrecK) Nothing)+ -- 1 with and without tz+ ,("time with time zone"+ ,TimeTypeName [Name Nothing "time"] Nothing True)+ ,("datetime(3) without time zone"+ ,TimeTypeName [Name Nothing "datetime"] (Just 3) False)+ -- chars: (single/multiname) x prec x charset x collate+ -- 1111+ ,("char varying(5) character set something collate something_insensitive"+ ,CharTypeName [Name Nothing "char varying"] (Just 5)+ [Name Nothing "something"] [Name Nothing "something_insensitive"])+ -- 0111+ ,("char(5) character set something collate something_insensitive"+ ,CharTypeName [Name Nothing "char"] (Just 5)+ [Name Nothing "something"] [Name Nothing "something_insensitive"])++ -- 1011+ ,("char varying character set something collate something_insensitive"+ ,CharTypeName [Name Nothing "char varying"] Nothing+ [Name Nothing "something"] [Name Nothing "something_insensitive"])+ -- 0011+ ,("char character set something collate something_insensitive"+ ,CharTypeName [Name Nothing "char"] Nothing+ [Name Nothing "something"] [Name Nothing "something_insensitive"])++ -- 1101+ ,("char varying(5) collate something_insensitive"+ ,CharTypeName [Name Nothing "char varying"] (Just 5)+ [] [Name Nothing "something_insensitive"])+ -- 0101+ ,("char(5) collate something_insensitive"+ ,CharTypeName [Name Nothing "char"] (Just 5)+ [] [Name Nothing "something_insensitive"])+ -- 1001+ ,("char varying collate something_insensitive"+ ,CharTypeName [Name Nothing "char varying"] Nothing+ [] [Name Nothing "something_insensitive"])+ -- 0001+ ,("char collate something_insensitive"+ ,CharTypeName [Name Nothing "char"] Nothing+ [] [Name Nothing "something_insensitive"])++ -- 1110+ ,("char varying(5) character set something"+ ,CharTypeName [Name Nothing "char varying"] (Just 5)+ [Name Nothing "something"] [])+ -- 0110+ ,("char(5) character set something"+ ,CharTypeName [Name Nothing "char"] (Just 5)+ [Name Nothing "something"] [])+ -- 1010+ ,("char varying character set something"+ ,CharTypeName [Name Nothing "char varying"] Nothing+ [Name Nothing "something"] [])+ -- 0010+ ,("char character set something"+ ,CharTypeName [Name Nothing "char"] Nothing+ [Name Nothing "something"] [])+ -- 1100+ ,("char varying character set something"+ ,CharTypeName [Name Nothing "char varying"] Nothing+ [Name Nothing "something"] [])++ -- single row field, two row field+ ,("row(a int)", RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])])+ ,("row(a int,b char)"+ ,RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])+ ,(Name Nothing "b", TypeName [Name Nothing "char"])])+ -- interval each type raw+ ,("interval year"+ ,IntervalTypeName (Itf "year" Nothing) Nothing)+ -- one type with single suffix+ -- one type with double suffix+ ,("interval year(2)"+ ,IntervalTypeName (Itf "year" $ Just (2,Nothing)) Nothing)+ ,("interval second(2,5)"+ ,IntervalTypeName (Itf "second" $ Just (2,Just 5)) Nothing)+ -- a to b with raw+ -- a to b with single suffix+ ,("interval year to month"+ ,IntervalTypeName (Itf "year" Nothing)+ (Just $ Itf "month" Nothing))+ ,("interval year(4) to second(2,3)"+ ,IntervalTypeName (Itf "year" $ Just (4,Nothing))+ (Just $ Itf "second" $ Just (2, Just 3)))+ ]++{-+Now test each variation in both cast expression and typed literal+expression+-}++typeNameTests :: TestItem+typeNameTests = Group "type names"+ [Group "type names" $ map (uncurry (TestScalarExpr ansi2011))+ $ concatMap makeSimpleTests $ fst typeNames+ ,Group "generated casts" $ map (uncurry (TestScalarExpr ansi2011))+ $ concatMap makeCastTests $ fst typeNames+ ,Group "generated typename" $ map (uncurry (TestScalarExpr ansi2011))+ $ concatMap makeTests $ snd typeNames]+ where+ makeSimpleTests (ctn, stn) =+ [(ctn <> " 'test'", TypedLit stn "test")+ ]+ makeCastTests (ctn, stn) =+ [("cast('test' as " <> ctn <> ")", Cast (StringLit "'" "'" "test") stn)+ ]+ makeTests a = makeSimpleTests a <> makeCastTests a+++{-+== 6.2 <field definition>++Function+Define a field of a row type.++<field definition> ::= <field name> <data type>+-}++fieldDefinition :: TestItem+fieldDefinition = Group "field definition"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("cast('(1,2)' as row(a int,b char))"+ ,Cast (StringLit "'" "'" "(1,2)")+ $ RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])+ ,(Name Nothing "b", TypeName [Name Nothing "char"])])]++{-+== 6.3 <value expression primary>++Function+Specify a value that is syntactically self-delimited.++<value expression primary> ::=+ <parenthesized value expression>+ | <nonparenthesized value expression primary>++<parenthesized value expression> ::=+ <left paren> <value expression> <right paren>++<nonparenthesized value expression primary> ::=+ <unsigned value specification>+ | <column reference>+ | <set function specification>+ | <window function>+ | <nested window function>+ | <scalar subquery>+ | <case expression>+ | <cast specification>+ | <field reference>+ | <subtype treatment>+ | <method invocation>+ | <static method invocation>+ | <new specification>+ | <attribute or method reference>+ | <reference resolution>+ | <collection value constructor>+ | <array element reference>+ | <multiset element reference>+ | <next value expression>+ | <routine invocation>++<collection value constructor> ::=+ <array value constructor>+ | <multiset value constructor>+-}++valueExpressions :: TestItem+valueExpressions = Group "value expressions"+ [generalValueSpecification+ ,parameterSpecification+ ,contextuallyTypedValueSpecification+ ,identifierChain+ ,columnReference+ ,setFunctionSpecification+ ,windowFunction+ ,nestedWindowFunction+ ,caseExpression+ ,castSpecification+ ,nextScalarExpression+ ,fieldReference+ ,arrayElementReference+ ,multisetElementReference+ ,numericScalarExpression+ ,numericValueFunction+ ,stringScalarExpression+ ,stringValueFunction+ ,datetimeScalarExpression+ ,datetimeValueFunction+ ,intervalScalarExpression+ ,intervalValueFunction+ ,booleanScalarExpression+ ,arrayScalarExpression+ ,arrayValueFunction+ ,arrayValueConstructor+ ,multisetScalarExpression+ ,multisetValueFunction+ ,multisetValueConstructor+ ,parenthesizedScalarExpression+ ]++parenthesizedScalarExpression :: TestItem+parenthesizedScalarExpression = Group "parenthesized value expression"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("(3)", Parens (NumLit "3"))+ ,("((3))", Parens $ Parens (NumLit "3"))+ ]++{-+== 6.4 <value specification> and <target specification>++Function+Specify one or more values, host parameters, SQL parameters, dynamic parameters, or host variables.++<value specification> ::= <literal> | <general value specification>++<unsigned value specification> ::=+ <unsigned literal>+ | <general value specification>++ <general value specification> ::=+ <host parameter specification>+ | <SQL parameter reference>+ | <dynamic parameter specification>+ | <embedded variable specification>+ | <current collation specification>+ | CURRENT_CATALOG+ | CURRENT_DEFAULT_TRANSFORM_GROUP+ | CURRENT_PATH+ | CURRENT_ROLE+ | CURRENT_SCHEMA+ | CURRENT_TRANSFORM_GROUP_FOR_TYPE <path-resolved user-defined type name>+ | CURRENT_USER+ | SESSION_USER+ | SYSTEM_USER+ | USER+ | VALUE+-}++generalValueSpecification :: TestItem+generalValueSpecification = Group "general value specification"+ $ map (uncurry (TestScalarExpr ansi2011)) $+ map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"+ ,"CURRENT_PATH"+ ,"CURRENT_ROLE"+ ,"CURRENT_USER"+ ,"SESSION_USER"+ ,"SYSTEM_USER"+ ,"USER"+ ,"VALUE"]+ where+ mkIden nm = (nm,Iden [Name Nothing nm])++{-+TODO: add the missing bits++<simple value specification> ::=+ <literal>+ | <host parameter name>+ | <SQL parameter reference>+ | <embedded variable name>++<target specification> ::=+ <host parameter specification>+ | <SQL parameter reference>+ | <column reference>+ | <target array element specification>+ | <dynamic parameter specification>+ | <embedded variable specification>++<simple target specification> ::=+ <host parameter name>+ | <SQL parameter reference>+ | <column reference>+ | <embedded variable name>++<host parameter specification> ::=+ <host parameter name> [ <indicator parameter> ]++<dynamic parameter specification> ::= <question mark>++<embedded variable specification> ::=+ <embedded variable name> [ <indicator variable> ]++<indicator variable> ::= [ INDICATOR ] <embedded variable name>++<indicator parameter> ::= [ INDICATOR ] <host parameter name>++<target array element specification> ::=+ <target array reference>+ <left bracket or trigraph> <simple value specification> <right bracket or trigraph>++<target array reference> ::= <SQL parameter reference> | <column reference>+-}++parameterSpecification :: TestItem+parameterSpecification = Group "parameter specification"+ $ map (uncurry (TestScalarExpr ansi2011))+ [(":hostparam", HostParameter ":hostparam" Nothing)+ ,(":hostparam indicator :another_host_param"+ ,HostParameter ":hostparam" $ Just ":another_host_param")+ ,("?", Parameter)+ ,(":h[3]", Array (HostParameter ":h" Nothing) [NumLit "3"])+ ]++{-+<current collation specification> ::=+ COLLATION FOR <left paren> <string value expression> <right paren>++TODO: review the modules stuff++== 6.5 <contextually typed value specification>++Function+Specify a value whose data type is to be inferred from its context.++<contextually typed value specification> ::=+ <implicitly typed value specification>+ | <default specification>++<implicitly typed value specification> ::=+ <null specification>+ | <empty specification>++<null specification> ::= NULL++<empty specification> ::=+ ARRAY <left bracket or trigraph> <right bracket or trigraph>+ | MULTISET <left bracket or trigraph> <right bracket or trigraph>++<default specification> ::= DEFAULT+-}++contextuallyTypedValueSpecification :: TestItem+contextuallyTypedValueSpecification =+ Group "contextually typed value specification"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("null", Iden [Name Nothing "null"])+ ,("array[]", Array (Iden [Name Nothing "array"]) [])+ ,("multiset[]", MultisetCtor [])+ ,("default", Iden [Name Nothing "default"])+ ]++{-+== 6.6 <identifier chain>++Function+Disambiguate a <period>-separated chain of identifiers.++<identifier chain> ::= <identifier> [ { <period> <identifier> }... ]++<basic identifier chain> ::= <identifier chain>+-}++identifierChain :: TestItem+identifierChain = Group "identifier chain"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("a.b", Iden [Name Nothing "a",Name Nothing "b"])]++{-+== 6.7 <column reference>++Function+Reference a column.++<column reference> ::=+ <basic identifier chain>+ | MODULE <period> <qualified identifier> <period> <column name>+-}++columnReference :: TestItem+columnReference = Group "column reference"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("module.a.b", Iden [Name Nothing "module",Name Nothing "a",Name Nothing "b"])]++{-+== 6.8 <SQL parameter reference>++Function+Reference an SQL parameter.++<SQL parameter reference> ::= <basic identifier chain>++== 6.9 <set function specification>++Function+Specify a value derived by the application of a function to an argument.++<set function specification> ::= <aggregate function> | <grouping operation>++<grouping operation> ::=+ GROUPING <left paren> <column reference>+ [ { <comma> <column reference> }... ] <right paren>+-}++setFunctionSpecification :: TestItem+setFunctionSpecification = Group "set function specification"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\+ \ GROUPING(SalesQuota) AS Grouping\n\+ \FROM Sales.SalesPerson\n\+ \GROUP BY ROLLUP(SalesQuota);"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "SalesQuota"],Nothing)+ ,(App [Name Nothing "SUM"] [Iden [Name Nothing "SalesYTD"]]+ ,Just (Name Nothing "TotalSalesYTD"))+ ,(App [Name Nothing "GROUPING"] [Iden [Name Nothing "SalesQuota"]]+ ,Just (Name Nothing "Grouping"))]+ ,msFrom = [TRSimple [Name Nothing "Sales",Name Nothing "SalesPerson"]]+ ,msGroupBy = [Rollup [SimpleGroup (Iden [Name Nothing "SalesQuota"])]]})+ ]++{-+== 6.10 <window function>++Function+Specify a window function.++<window function> ::=+ <window function type> OVER <window name or specification>++<window function type> ::=+ <rank function type> <left paren> <right paren>+ | ROW_NUMBER <left paren> <right paren>+ | <aggregate function>+ | <ntile function>+ | <lead or lag function>+ | <first or last value function>+ | <nth value function>++<rank function type> ::= RANK | DENSE_RANK | PERCENT_RANK | CUME_DIST++<ntile function> ::= NTILE <left paren> <number of tiles> <right paren>++<number of tiles> ::=+ <simple value specification>+ | <dynamic parameter specification>++<lead or lag function> ::=+ <lead or lag> <left paren> <lead or lag extent>+ [ <comma> <offset> [ <comma> <default expression> ] ] <right paren>+ [ <null treatment> ]++<lead or lag> ::= LEAD | LAG++<lead or lag extent> ::= <value expression>++<offset> ::= <exact numeric literal>++<default expression> ::= <value expression>++<null treatment> ::= RESPECT NULLS | IGNORE NULLS++<first or last value function> ::=+ <first or last value> <left paren> <value expression> <right paren> [ <null treatment>+ ]++<first or last value> ::= FIRST_VALUE | LAST_VALUE++<nth value function> ::=+ NTH_VALUE <left paren> <value expression> <comma> <nth row> <right paren>+ [ <from first or last> ] [ <null treatment> ]++<nth row> ::= <simple value specification> | <dynamic parameter specification>++<from first or last> ::= FROM FIRST | FROM LAST++<window name or specification> ::=+ <window name>+ | <in-line window specification>++<in-line window specification> ::= <window specification>+-}++windowFunction :: TestItem+windowFunction = Group "window function"+ [-- todo: window function+ ]++{-+== 6.11 <nested window function>++Function++Specify a function nested in an aggregated argument of an+<aggregate function> simply contained in a <window function>.++<nested window function> ::=+ <nested row number function>+ | <value_of expression at row>++<nested row number function> ::=+ ROW_NUMBER <left paren> <row marker> <right paren>++<value_of expression at row> ::=+ VALUE_OF <left paren> <value expression> AT <row marker expression>+ [ <comma> <value_of default value> ] <right paren>++<row marker> ::=+ BEGIN_PARTITION+ | BEGIN_FRAME+ | CURRENT_ROW+ | FRAME_ROW+ | END_FRAME+ | END_PARTITION++<row marker expression> ::= <row marker> [ <row marker delta> ]++<row marker delta> ::=+ <plus sign> <row marker offset>+ | <minus sign> <row marker offset>++<row marker offset> ::=+ <simple value specification>+ | <dynamic parameter specification>++<value_of default value> ::= <value expression>+-}++nestedWindowFunction :: TestItem+nestedWindowFunction = Group "nested window function"+ [-- todo: nested window function+ ]+++{-+== 6.12 <case expression>++Function+Specify a conditional value.++<case expression> ::= <case abbreviation> | <case specification>++<case abbreviation> ::=+ NULLIF <left paren> <value expression> <comma> <value expression> <right paren>+ | COALESCE <left paren> <value expression>+ { <comma> <value expression> }... <right paren>++<case specification> ::= <simple case> | <searched case>++<simple case> ::=+ CASE <case operand> <simple when clause>... [ <else clause> ] END++<searched case> ::= CASE <searched when clause>... [ <else clause> ] END++<simple when clause> ::= WHEN <when operand list> THEN <result>++<searched when clause> ::= WHEN <search condition> THEN <result>++<else clause> ::= ELSE <result>++<case operand> ::= <row value predicand> | <overlaps predicate part 1>++<when operand list> ::= <when operand> [ { <comma> <when operand> }... ]++<when operand> ::=+ <row value predicand>+ | <comparison predicate part 2>+ | <between predicate part 2>+ | <in predicate part 2>+ | <character like predicate part 2>+ | <octet like predicate part 2>+ | <similar predicate part 2>+ | <regex like predicate part 2>+ | <null predicate part 2>+ | <quantified comparison predicate part 2>+ | <normalized predicate part 2>+ | <match predicate part 2>+ | <overlaps predicate part 2>+ | <distinct predicate part 2>+ | <member predicate part 2>+ | <submultiset predicate part 2>+ | <set predicate part 2>+ | <type predicate part 2>++I haven't seen these part 2 style when operands in the wild. It+doesn't even allow all the binary operators here. We will allow them+all, and parser and represent these expressions by considering all the+binary ops as unary prefix ops.++<result> ::= <result expression> | NULL++<result expression> ::= <value expression>+-}++caseExpression :: TestItem+caseExpression = Group "case expression"+ [-- todo: case expression+ ]++{-+== 6.13 <cast specification>++Function+Specify a data conversion.++<cast specification> ::=+ CAST <left paren> <cast operand> AS <cast target> <right paren>++<cast operand> ::= <value expression> | <implicitly typed value specification>++<cast target> ::= <domain name> | <data type>+-}++castSpecification :: TestItem+castSpecification = Group "cast specification"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("cast(a as int)"+ ,Cast (Iden [Name Nothing "a"]) (TypeName [Name Nothing "int"]))+ ]++{-+== 6.14 <next value expression>++Function+Return the next value of a sequence generator.++<next value expression> ::= NEXT VALUE FOR <sequence generator name>+-}++nextScalarExpression :: TestItem+nextScalarExpression = Group "next value expression"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("next value for a.b", NextValueFor [Name Nothing "a", Name Nothing "b"])+ ]++{-+== 6.15 <field reference>++Function+Reference a field of a row value.++<field reference> ::= <value expression primary> <period> <field name>+-}++fieldReference :: TestItem+fieldReference = Group "field reference"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("f(something).a"+ ,BinOp (App [Name Nothing "f"] [Iden [Name Nothing "something"]])+ [Name Nothing "."]+ (Iden [Name Nothing "a"]))+ ]++{-+TODO: try all possible value expression syntax variations followed by+field reference++== 6.16 <subtype treatment>++Function+Modify the declared type of an expression.++<subtype treatment> ::=+ TREAT <left paren> <subtype operand> AS <target subtype> <right paren>++<subtype operand> ::= <value expression>++<target subtype> ::= <path-resolved user-defined type name> | <reference type>++todo: subtype treatment++== 6.17 <method invocation>++Function+Reference an SQL-invoked method of a user-defined type value.++<method invocation> ::= <direct invocation> | <generalized invocation>++<direct invocation> ::=+ <value expression primary> <period> <method name> [ <SQL argument list> ]++<generalized invocation> ::=+ <left paren> <value expression primary> AS <data type> <right paren>+ <period> <method name> [ <SQL argument list> ]++<method selection> ::= <routine invocation>++<constructor method selection> ::= <routine invocation>++todo: method invocation++== 6.18 <static method invocation>++Function+Invoke a static method.++<static method invocation> ::=+ <path-resolved user-defined type name> <double colon> <method name>+ [ <SQL argument list> ]++<static method selection> ::= <routine invocation>++todo: static method invocation++== 6.19 <new specification>++Function+Invoke a method on a newly-constructed value of a structured type.++<new specification> ::=+ NEW <path-resolved user-defined type name> <SQL argument list>++<new invocation> ::= <method invocation> | <routine invocation>++todo: new specification++== 6.20 <attribute or method reference>++Function+Return a value acquired by accessing a column of the row identified by+a value of a reference type or by invoking an SQL-invoked method.++<attribute or method reference> ::=+ <value expression primary> <dereference operator> <qualified identifier>+ [ <SQL argument list> ]++<dereference operator> ::= <right arrow>++todo: attribute of method reference++== 6.21 <dereference operation>++Function+Access a column of the row identified by a value of a reference type.++<dereference operation> ::=+ <reference value expression> <dereference operator> <attribute name>++todo: deference operation++== 6.22 <method reference>++Function+Return a value acquired from invoking an SQL-invoked routine that is a method.++<method reference> ::=+ <value expression primary> <dereference operator> <method name> <SQL argument list>++todo: method reference++== 6.23 <reference resolution>++Function+Obtain the value referenced by a reference value.++<reference resolution> ::=+ DEREF <left paren> <reference value expression> <right paren>++todo: reference resolution++== 6.24 <array element reference>++Function+Return an element of an array.++<array element reference> ::=+ <array value expression>+ <left bracket or trigraph> <numeric value expression> <right bracket or trigraph>+-}++arrayElementReference :: TestItem+arrayElementReference = Group "array element reference"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("something[3]"+ ,Array (Iden [Name Nothing "something"]) [NumLit "3"])+ ,("(something(a))[x]"+ ,Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))+ [Iden [Name Nothing "x"]])+ ,("(something(a))[x][y] "+ ,Array (+ Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))+ [Iden [Name Nothing "x"]])+ [Iden [Name Nothing "y"]])+ ]++{-+== 6.25 <multiset element reference>++Function+Return the sole element of a multiset of one element.++<multiset element reference> ::=+ ELEMENT <left paren> <multiset value expression> <right paren>+-}++multisetElementReference :: TestItem+multisetElementReference = Group "multisetElementReference"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("element(something)"+ ,App [Name Nothing "element"] [Iden [Name Nothing "something"]])+ ]++{-+== 6.26 <value expression>++Function+Specify a value.++<value expression> ::=+ <common value expression>+ | <boolean value expression>+ | <row value expression>++<common value expression> ::=+ <numeric value expression>+ | <string value expression>+ | <datetime value expression>+ | <interval value expression>+ | <user-defined type value expression>+ | <reference value expression>+ | <collection value expression>++<user-defined type value expression> ::= <value expression primary>++<reference value expression> ::= <value expression primary>++<collection value expression> ::=+ <array value expression>+ | <multiset value expression>++== 6.27 <numeric value expression>++Function+Specify a numeric value.++<numeric value expression> ::=+ <term>+ | <numeric value expression> <plus sign> <term>+ | <numeric value expression> <minus sign> <term>++<term> ::= <factor> | <term> <asterisk> <factor> | <term> <solidus> <factor>++<factor> ::= [ <sign> ] <numeric primary>++<numeric primary> ::= <value expression primary> | <numeric value function>+-}++numericScalarExpression :: TestItem+numericScalarExpression = Group "numeric value expression"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("a + b", binOp "+")+ ,("a - b", binOp "-")+ ,("a * b", binOp "*")+ ,("a / b", binOp "/")+ ,("+a", prefOp "+")+ ,("-a", prefOp "-")+ ]+ where+ binOp o = BinOp (Iden [Name Nothing "a"]) [Name Nothing o] (Iden [Name Nothing "b"])+ prefOp o = PrefixOp [Name Nothing o] (Iden [Name Nothing "a"])++{-+TODO: precedence and associativity tests (need to review all operators+for what precendence and associativity tests to write)++== 6.28 <numeric value function>++Function+Specify a function yielding a value of type numeric.++<numeric value function> ::=+ <position expression>+ | <regex occurrences function>+ | <regex position expression>+ | <extract expression>+ | <length expression>+ | <cardinality expression>+ | <max cardinality expression>+ | <absolute value expression>+ | <modulus expression>+ | <natural logarithm>+ | <exponential function>+ | <power function>+ | <square root>+ | <floor function>+ | <ceiling function>+ | <width bucket function>+-}+++numericValueFunction :: TestItem+numericValueFunction = Group "numeric value function"+ [-- todo: numeric value function+ ]++{-+<position expression> ::=+ <character position expression>+ | <binary position expression>++<regex occurrences function> ::=+ OCCURRENCES_REGEX <left paren>+ <XQuery pattern> [ FLAG <XQuery option flag> ]+ IN <regex subject string>+ [ FROM <start position> ]+ [ USING <char length units> ]+ <right paren>++<XQuery pattern> ::= <character value expression>++<XQuery option flag> ::= <character value expression>++<regex subject string> ::= <character value expression>++<regex position expression> ::=+ POSITION_REGEX <left paren>+ [ <regex position start or after> ]+ <XQuery pattern> [ FLAG <XQuery option flag> ]+ IN <regex subject string>+ [ FROM <start position> ]+ [ USING <char length units> ]+ [ OCCURRENCE <regex occurrence> ]+ [ GROUP <regex capture group> ]+ <right paren>++<regex position start or after> ::= START | AFTER++<regex occurrence> ::= <numeric value expression>++<regex capture group> ::= <numeric value expression>++<character position expression> ::=+ POSITION <left paren> <character value expression 1> IN <character value expression 2>+ [ USING <char length units> ] <right paren>++<character value expression 1> ::= <character value expression>++<character value expression 2> ::= <character value expression>++<binary position expression> ::=+ POSITION <left paren> <binary value expression> IN <binary value expression> <right paren>++<length expression> ::= <char length expression> | <octet length expression>++<char length expression> ::=+ { CHAR_LENGTH | CHARACTER_LENGTH } <left paren> <character value expression>+ [ USING <char length units> ] <right paren>++<octet length expression> ::=+ OCTET_LENGTH <left paren> <string value expression> <right paren>++<extract expression> ::=+ EXTRACT <left paren> <extract field> FROM <extract source> <right paren>++<extract field> ::= <primary datetime field> | <time zone field>++<time zone field> ::= TIMEZONE_HOUR | TIMEZONE_MINUTE++<extract source> ::= <datetime value expression> | <interval value expression>++<cardinality expression> ::=+ CARDINALITY <left paren> <collection value expression> <right paren>++<max cardinality expression> ::=+ ARRAY_MAX_CARDINALITY <left paren> <array value expression> <right paren>++<absolute value expression> ::=+ ABS <left paren> <numeric value expression> <right paren>++<modulus expression> ::=+ MOD <left paren> <numeric value expression dividend> <comma>+ <numeric value expression divisor> <right paren>++<numeric value expression dividend> ::= <numeric value expression>++<numeric value expression divisor> ::= <numeric value expression>++<natural logarithm> ::=+ LN <left paren> <numeric value expression> <right paren>++<exponential function> ::=+ EXP <left paren> <numeric value expression> <right paren>++<power function> ::=+ POWER <left paren> <numeric value expression base> <comma>+ <numeric value expression exponent> <right paren>++<numeric value expression base> ::= <numeric value expression>++<numeric value expression exponent> ::= <numeric value expression>++<square root> ::= SQRT <left paren> <numeric value expression> <right paren>++<floor function> ::=+ FLOOR <left paren> <numeric value expression> <right paren>++<ceiling function> ::=+ { CEIL | CEILING } <left paren> <numeric value expression> <right paren>++<width bucket function> ::=+ WIDTH_BUCKET <left paren> <width bucket operand> <comma> <width bucket bound 1> <comma>+ <width bucket bound 2> <comma> <width bucket count> <right paren>++<width bucket operand> ::= <numeric value expression>++<width bucket bound 1> ::= <numeric value expression>++<width bucket bound 2> ::= <numeric value expression>++<width bucket count> ::= <numeric value expression>++== 6.29 <string value expression>++Function+Specify a character string value or a binary string value.++<string value expression> ::=+ <character value expression>+ | <binary value expression>++<character value expression> ::= <concatenation> | <character factor>++<concatenation> ::=+ <character value expression> <concatenation operator> <character factor>++<character factor> ::= <character primary> [ <collate clause> ]++<character primary> ::= <value expression primary> | <string value function>++<binary value expression> ::= <binary concatenation> | <binary factor>++<binary factor> ::= <binary primary>++<binary primary> ::= <value expression primary> | <string value function>++<binary concatenation> ::=+ <binary value expression> <concatenation operator> <binary factor>+-}++stringScalarExpression :: TestItem+stringScalarExpression = Group "string value expression"+ [-- todo: string value expression+ ]++{-+== 6.30 <string value function>++Function+Specify a function yielding a value of type character string or binary string.++<string value function> ::=+ <character value function>+ | <binary value function>++<character value function> ::=+ <character substring function>+ | <regular expression substring function>+ | <regex substring function>+ | <fold>+ | <transcoding>+ | <character transliteration>+ | <regex transliteration>+ | <trim function>+ | <character overlay function>+ | <normalize function>+ | <specific type method>+-}++stringValueFunction :: TestItem+stringValueFunction = Group "string value function"+ [-- todo: string value function+ ]++{-+<character substring function> ::=+ SUBSTRING <left paren> <character value expression> FROM <start position>+ [ FOR <string length> ] [ USING <char length units> ] <right paren>++<regular expression substring function> ::=+ SUBSTRING <left paren> <character value expression> SIMILAR <character value expression>+ ESCAPE <escape character> <right paren>++<regex substring function> ::=+ SUBSTRING_REGEX <left paren>+ <XQuery pattern> [ FLAG <XQuery option flag> ]+ IN <regex subject string>+ [ FROM <start position> ]+ [ USING <char length units> ]+ [ OCCURRENCE <regex occurrence> ]+ [ GROUP <regex capture group> ]+ <right paren>++<fold> ::=+ { UPPER | LOWER } <left paren> <character value expression> <right paren>++<transcoding> ::=+ CONVERT <left paren> <character value expression>+ USING <transcoding name> <right paren>++<character transliteration> ::=+ TRANSLATE <left paren> <character value expression>+ USING <transliteration name> <right paren>++<regex transliteration> ::=+ TRANSLATE_REGEX <left paren>+ <XQuery pattern> [ FLAG <XQuery option flag> ]+ IN <regex subject string>+ [ WITH <XQuery replacement string> ]+ [ FROM <start position> ]+ [ USING <char length units> ]+ [ OCCURRENCE <regex transliteration occurrence> ]+ <right paren>++<XQuery replacement string> ::= <character value expression>++<regex transliteration occurrence> ::= <regex occurrence> | ALL++<trim function> ::= TRIM <left paren> <trim operands> <right paren>++<trim operands> ::=+ [ [ <trim specification> ] [ <trim character> ] FROM ] <trim source>++<trim source> ::= <character value expression>++<trim specification> ::= LEADING | TRAILING | BOTH++<trim character> ::= <character value expression>++<character overlay function> ::=+ OVERLAY <left paren> <character value expression> PLACING <character value expression>+ FROM <start position> [ FOR <string length> ]+ [ USING <char length units> ] <right paren>++<normalize function> ::=+ NORMALIZE <left paren> <character value expression>+ [ <comma> <normal form> [ <comma> <normalize function result length> ] ] <right paren>++<normal form> ::= NFC | NFD | NFKC | NFKD++<normalize function result length> ::=+ <character length>+ | <character large object length>++<specific type method> ::=+ <user-defined type value expression> <period> SPECIFICTYPE+ [ <left paren> <right paren> ]++<binary value function> ::=+ <binary substring function>+ | <binary trim function>+ | <binary overlay function>++<binary substring function> ::=+ SUBSTRING <left paren> <binary value expression> FROM <start position>+ [ FOR <string length> ] <right paren>++<binary trim function> ::=+ TRIM <left paren> <binary trim operands> <right paren>++<binary trim operands> ::=+ [ [ <trim specification> ] [ <trim octet> ] FROM ] <binary trim source>++<binary trim source> ::= <binary value expression>++<trim octet> ::= <binary value expression>++<binary overlay function> ::=+ OVERLAY <left paren> <binary value expression> PLACING <binary value expression>+ FROM <start position> [ FOR <string length> ] <right paren>++<start position> ::= <numeric value expression>++<string length> ::= <numeric value expression>++== 6.31 <datetime value expression>++Function+Specify a datetime value.++<datetime value expression> ::=+ <datetime term>+ | <interval value expression> <plus sign> <datetime term>+ | <datetime value expression> <plus sign> <interval term>+ | <datetime value expression> <minus sign> <interval term>+-}++datetimeScalarExpression :: TestItem+datetimeScalarExpression = Group "datetime value expression"+ [-- todo: datetime value expression+ datetimeValueFunction + ]++{-+<datetime term> ::= <datetime factor>++<datetime factor> ::= <datetime primary> [ <time zone> ]++<datetime primary> ::= <value expression primary> | <datetime value function>++<time zone> ::= AT <time zone specifier>++<time zone specifier> ::= LOCAL | TIME ZONE <interval primary>++== 6.32 <datetime value function>++Function+Specify a function yielding a value of type datetime.++<datetime value function> ::=+ <current date value function>+ | <current time value function>+ | <current timestamp value function>+ | <current local time value function>+ | <current local timestamp value function>+-}++datetimeValueFunction :: TestItem+datetimeValueFunction = Group "datetime value function"+ [-- todo: datetime value function+ ]++{-+<current date value function> ::= CURRENT_DATE++<current time value function> ::=+ CURRENT_TIME [ <left paren> <time precision> <right paren> ]++<current local time value function> ::=+ LOCALTIME [ <left paren> <time precision> <right paren> ]++<current timestamp value function> ::=+ CURRENT_TIMESTAMP [ <left paren> <timestamp precision> <right paren> ]++<current local timestamp value function> ::=+ LOCALTIMESTAMP [ <left paren> <timestamp precision> <right paren> ]++== 6.33 <interval value expression>++Function+Specify an interval value.++<interval value expression> ::=+ <interval term>+ | <interval value expression 1> <plus sign> <interval term 1>+ | <interval value expression 1> <minus sign> <interval term 1>+ | <left paren> <datetime value expression> <minus sign> <datetime term> <right paren>+ <interval qualifier>+-}++intervalScalarExpression :: TestItem+intervalScalarExpression = Group "interval value expression"+ [-- todo: interval value expression+ ]+++{-+<interval term> ::=+ <interval factor>+ | <interval term 2> <asterisk> <factor>+ | <interval term 2> <solidus> <factor>+ | <term> <asterisk> <interval factor>++<interval factor> ::= [ <sign> ] <interval primary>++<interval primary> ::=+ <value expression primary> [ <interval qualifier> ]+ | <interval value function>++<interval value expression 1> ::= <interval value expression>++<interval term 1> ::= <interval term>++<interval term 2> ::= <interval term>++== 6.34 <interval value function>++Function+Specify a function yielding a value of type interval.++<interval value function> ::= <interval absolute value function>++<interval absolute value function> ::=+ ABS <left paren> <interval value expression> <right paren>+-}++intervalValueFunction :: TestItem+intervalValueFunction = Group "interval value function"+ [-- todo: interval value function+ ]+++{-+== 6.35 <boolean value expression>++Function+Specify a boolean value.++<boolean value expression> ::=+ <boolean term>+ | <boolean value expression> OR <boolean term>++<boolean term> ::= <boolean factor> | <boolean term> AND <boolean factor>++<boolean factor> ::= [ NOT ] <boolean test>++<boolean test> ::= <boolean primary> [ IS [ NOT ] <truth value> ]++<truth value> ::= TRUE | FALSE | UNKNOWN++<boolean primary> ::= <predicate> | <boolean predicand>++<boolean predicand> ::=+ <parenthesized boolean value expression>+ | <nonparenthesized value expression primary>++<parenthesized boolean value expression> ::=+ <left paren> <boolean value expression> <right paren>+-}+++booleanScalarExpression :: TestItem+booleanScalarExpression = Group "booleab value expression"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("a or b", BinOp a [Name Nothing "or"] b)+ ,("a and b", BinOp a [Name Nothing "and"] b)+ ,("not a", PrefixOp [Name Nothing "not"] a)+ ,("a is true", postfixOp "is true")+ ,("a is false", postfixOp "is false")+ ,("a is unknown", postfixOp "is unknown")+ ,("a is not true", postfixOp "is not true")+ ,("a is not false", postfixOp "is not false")+ ,("a is not unknown", postfixOp "is not unknown")+ ,("(a or b)", Parens $ BinOp a [Name Nothing "or"] b)+ ]+ where+ a = Iden [Name Nothing "a"]+ b = Iden [Name Nothing "b"]+ postfixOp nm = PostfixOp [Name Nothing nm] a++{-+TODO: review if more tests are needed. Should at least have+precendence tests for mixed and, or and not without parens.++== 6.36 <array value expression>++Function+Specify an array value.++<array value expression> ::= <array concatenation> | <array primary>++<array concatenation> ::=+ <array value expression 1> <concatenation operator> <array primary>++<array value expression 1> ::= <array value expression>++<array primary> ::= <array value function> | <value expression primary>+-}++arrayScalarExpression :: TestItem+arrayScalarExpression = Group "array value expression"+ [-- todo: array value expression+ ]++{-+== 6.37 <array value function>++Function+Specify a function yielding a value of an array type.++<array value function> ::= <trim array function>++<trim array function> ::=+ TRIM_ARRAY <left paren> <array value expression> <comma> <numeric value expression>+ <right paren>+-}++arrayValueFunction :: TestItem+arrayValueFunction = Group "array value function"+ [-- todo: array value function+ ]++{-+== 6.38 <array value constructor>++Function+Specify construction of an array.++<array value constructor> ::=+ <array value constructor by enumeration>+ | <array value constructor by query>++<array value constructor by enumeration> ::=+ ARRAY <left bracket or trigraph> <array element list> <right bracket or trigraph>++<array element list> ::= <array element> [ { <comma> <array element> }... ]++<array element> ::= <value expression>++<array value constructor by query> ::= ARRAY <table subquery>+-}++arrayValueConstructor :: TestItem+arrayValueConstructor = Group "array value constructor"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("array[1,2,3]"+ ,Array (Iden [Name Nothing "array"])+ [NumLit "1", NumLit "2", NumLit "3"])+ ,("array[a,b,c]"+ ,Array (Iden [Name Nothing "array"])+ [Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]])+ ,("array(select * from t)"+ ,ArrayCtor (toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}))+ ,("array(select * from t order by a)"+ ,ArrayCtor (toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msOrderBy = [SortSpec (Iden [Name Nothing "a"])+ DirDefault NullsOrderDefault]}))+ ]+++{-+== 6.39 <multiset value expression>++Function+Specify a multiset value.++<multiset value expression> ::=+ <multiset term>+ | <multiset value expression> MULTISET UNION [ ALL | DISTINCT ] <multiset term>+ | <multiset value expression> MULTISET EXCEPT [ ALL | DISTINCT ] <multiset term>++<multiset term> ::=+ <multiset primary>+ | <multiset term> MULTISET INTERSECT [ ALL | DISTINCT ] <multiset primary>++<multiset primary> ::= <multiset value function> | <value expression primary>+-}++multisetScalarExpression :: TestItem+multisetScalarExpression = Group "multiset value expression"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("a multiset union b"+ ,MultisetBinOp (Iden [Name Nothing "a"]) Union SQDefault (Iden [Name Nothing "b"]))+ ,("a multiset union all b"+ ,MultisetBinOp (Iden [Name Nothing "a"]) Union All (Iden [Name Nothing "b"]))+ ,("a multiset union distinct b"+ ,MultisetBinOp (Iden [Name Nothing "a"]) Union Distinct (Iden [Name Nothing "b"]))+ ,("a multiset except b"+ ,MultisetBinOp (Iden [Name Nothing "a"]) Except SQDefault (Iden [Name Nothing "b"]))+ ,("a multiset intersect b"+ ,MultisetBinOp (Iden [Name Nothing "a"]) Intersect SQDefault (Iden [Name Nothing "b"]))+ ]++{-+TODO: check precedence and associativity++== 6.40 <multiset value function>++Function+Specify a function yielding a value of a multiset type.++<multiset value function> ::= <multiset set function>++<multiset set function> ::=+ SET <left paren> <multiset value expression> <right paren>++TODO: set is now a reserved keyword. Fix the set parsing with a+special case term.+-}++multisetValueFunction :: TestItem+multisetValueFunction = Group "multiset value function"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("set(a)", App [Name Nothing "set"] [Iden [Name Nothing "a"]])+ ]++{-+== 6.41 <multiset value constructor>++Function+Specify construction of a multiset.++<multiset value constructor> ::=+ <multiset value constructor by enumeration>+ | <multiset value constructor by query>+ | <table value constructor by query>++<multiset value constructor by enumeration> ::=+ MULTISET <left bracket or trigraph> <multiset element list> <right bracket or trigraph>++<multiset element list> ::=+ <multiset element> [ { <comma> <multiset element> }... ]++<multiset element> ::= <value expression>++<multiset value constructor by query> ::= MULTISET <table subquery>++<table value constructor by query> ::= TABLE <table subquery>+-}++multisetValueConstructor :: TestItem+multisetValueConstructor = Group "multiset value constructor"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("multiset[a,b,c]", MultisetCtor[Iden [Name Nothing "a"]+ ,Iden [Name Nothing "b"], Iden [Name Nothing "c"]])+ ,("multiset(select * from t)", MultisetQueryCtor ms)+ ,("table(select * from t)", MultisetQueryCtor ms)+ ]+ where+ ms = toQueryExpr $ makeSelect {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}+++-- = 7 Query expressions++queryExpressions :: TestItem+queryExpressions = Group "query expressions"+ [rowValueConstructor+ ,tableValueConstructor+ ,fromClause+ ,tableReference+ ,joinedTable+ ,whereClause+ ,groupByClause+ ,havingClause+ ,windowClause+ ,querySpecification+ ,withQueryExpression+ ,setOpQueryExpression+ ,explicitTableQueryExpression+ ,orderOffsetFetchQueryExpression+ ,searchOrCycleClause+ ]+++{-+== 7.1 <row value constructor>++Function+Specify a value or list of values to be constructed into a row.++<row value constructor> ::=+ <common value expression>+ | <boolean value expression>+ | <explicit row value constructor>++<explicit row value constructor> ::=+ <left paren> <row value constructor element> <comma>+ <row value constructor element list> <right paren>+ | ROW <left paren> <row value constructor element list> <right paren>+ | <row subquery>++<row value constructor element list> ::=+ <row value constructor element> [ { <comma> <row value constructor element> }... ]++<row value constructor element> ::= <value expression>++<contextually typed row value constructor> ::=+ <common value expression>+ | <boolean value expression>+ | <contextually typed value specification>+ | <left paren> <contextually typed value specification> <right paren>+ | <left paren> <contextually typed row value constructor element> <comma>+ <contextually typed row value constructor element list> <right paren>+ | ROW <left paren> <contextually typed row value constructor element list> <right paren>++<contextually typed row value constructor element list> ::=+ <contextually typed row value constructor element>+ [ { <comma> <contextually typed row value constructor element> }... ]++<contextually typed row value constructor element> ::=+ <value expression>+ | <contextually typed value specification>++<row value constructor predicand> ::=+ <common value expression>+ | <boolean predicand>+ | <explicit row value constructor>+-}++rowValueConstructor :: TestItem+rowValueConstructor = Group "row value constructor"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("(a,b)"+ ,SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])+ ,("row(1)",App [Name Nothing "row"] [NumLit "1"])+ ,("row(1,2)",App [Name Nothing "row"] [NumLit "1",NumLit "2"])+ ]++{-+== 7.2 <row value expression>++Function+Specify a row value.++<row value expression> ::=+ <row value special case>+ | <explicit row value constructor>++<table row value expression> ::=+ <row value special case>+ | <row value constructor>++<contextually typed row value expression> ::=+ <row value special case>+ | <contextually typed row value constructor>++<row value predicand> ::=+ <row value special case>+ | <row value constructor predicand>++<row value special case> ::= <nonparenthesized value expression primary>++There is nothing new here.++== 7.3 <table value constructor>++Function+Specify a set of <row value expression>s to be constructed into a table.++<table value constructor> ::= VALUES <row value expression list>++<row value expression list> ::=+ <table row value expression> [ { <comma> <table row value expression> }... ]++<contextually typed table value constructor> ::=+ VALUES <contextually typed row value expression list>++<contextually typed row value expression list> ::=+ <contextually typed row value expression>+ [ { <comma> <contextually typed row value expression> }... ]+-}++tableValueConstructor :: TestItem+tableValueConstructor = Group "table value constructor"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("values (1,2), (a+b,(select count(*) from t));"+ ,Values [[NumLit "1", NumLit "2"]+ ,[BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]+ (Iden [Name Nothing "b"])+ ,SubQueryExpr SqSq+ (toQueryExpr $ makeSelect+ {msSelectList = [(App [Name Nothing "count"] [Star],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]})]])+ ]++{-+== 7.4 <table expression>++Function+Specify a table or a grouped table.++<table expression> ::=+ <from clause>+ [ <where clause> ]+ [ <group by clause> ]+ [ <having clause> ]+ [ <window clause> ]++== 7.5 <from clause>++Function+Specify a table derived from one or more tables.++<from clause> ::= FROM <table reference list>++<table reference list> ::=+ <table reference> [ { <comma> <table reference> }... ]+-}++fromClause :: TestItem+fromClause = Group "fromClause"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select * from tbl1,tbl2"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "tbl1"], TRSimple [Name Nothing "tbl2"]]+ })]+++{-+== 7.6 <table reference>++Function+Reference a table.+-}++tableReference :: TestItem+tableReference = Group "table reference"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select * from t", toQueryExpr sel)++{-+<table reference> ::= <table factor> | <joined table>++<table factor> ::= <table primary> [ <sample clause> ]++<sample clause> ::=+ TABLESAMPLE <sample method> <left paren> <sample percentage> <right paren>+ [ <repeatable clause> ]++<sample method> ::= BERNOULLI | SYSTEM++<repeatable clause> ::= REPEATABLE <left paren> <repeat argument> <right paren>++<sample percentage> ::= <numeric value expression>++<repeat argument> ::= <numeric value expression>++<table primary> ::=+ <table or query name> [ <query system time period specification> ]+ [ [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ] ]+ | <derived table> [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ]+ | <lateral derived table> [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ]+ | <collection derived table> [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ]+ | <table function derived table> [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ]+ | <only spec> [ [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ] ]+ | <data change delta table> [ [ AS ] <correlation name>+ [ <left paren> <derived column list> <right paren> ] ]+ | <parenthesized joined table>++<query system time period specification> ::=+ FOR SYSTEM_TIME AS OF <point in time 1>+ | FOR SYSTEM_TIME BETWEEN [ ASYMMETRIC | SYMMETRIC ]+ <point in time 1> AND <point in time 2>+ | FOR SYSTEM_TIME FROM <point in time 1> TO <point in time 2>++TODO: query system time period spec++<point in time 1> ::= <point in time>++<point in time 2> ::= <point in time>++<point in time> ::= <datetime value expression>++<only spec> ::= ONLY <left paren> <table or query name> <right paren>++TODO: only++<lateral derived table> ::= LATERAL <table subquery>++<collection derived table> ::=+ UNNEST <left paren> <collection value expression>+ [ { <comma> <collection value expression> }... ] <right paren>+ [ WITH ORDINALITY ]++<table function derived table> ::=+ TABLE <left paren> <collection value expression> <right paren>++<derived table> ::= <table subquery>++<table or query name> ::= <table name> | <transition table name> | <query name>++<derived column list> ::= <column name list>++<column name list> ::= <column name> [ { <comma> <column name> }... ]++<data change delta table> ::=+ <result option> TABLE <left paren> <data change statement> <right paren>++<data change statement> ::=+ <delete statement: searched>+ | <insert statement>+ | <merge statement>+ | <update statement: searched>++<result option> ::= FINAL | NEW | OLD++<parenthesized joined table> ::=+ <left paren> <parenthesized joined table> <right paren>+ | <left paren> <joined table> <right paren>+-}+++ -- table or query name+ ,("select * from t u", toQueryExpr $ a sel)+ ,("select * from t as u", toQueryExpr $ a sel)+ ,("select * from t u(a,b)", toQueryExpr sel1 )+ ,("select * from t as u(a,b)", toQueryExpr sel1)+ -- derived table TODO: realistic example+ ,("select * from (select * from t) u"+ ,toQueryExpr $ a $ sel {msFrom = [TRQueryExpr $ toQueryExpr sel]})+ -- lateral TODO: realistic example+ ,("select * from lateral t"+ ,toQueryExpr $ af TRLateral sel)+ -- TODO: bug, lateral should bind more tightly than the alias+ --,("select * from lateral t u"+ -- ,a $ af sel TRLateral)+ -- collection TODO: realistic example+ -- TODO: make it work+ --,("select * from unnest(a)", undefined)+ --,("select * from unnest(a,b)", undefined)+ --,("select * from unnest(a,b) with ordinality", undefined)+ --,("select * from unnest(a,b) with ordinality u", undefined)+ --,("select * from unnest(a,b) with ordinality as u", undefined)+ -- table fn TODO: realistic example+ -- TODO: make it work+ --,("select * from table(a)", undefined)+ -- parens+ ,("select * from (a join b)", toQueryExpr jsel)+ ,("select * from (a join b) u", toQueryExpr $ a jsel)+ ,("select * from ((a join b)) u", toQueryExpr $ a $ af TRParens jsel)+ ,("select * from ((a join b) u) u", toQueryExpr $ a $ af TRParens $ a jsel)+ ]+ where+ sel = makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}+ af f s = s {msFrom = map f (msFrom s)}+ a s = af (\x -> TRAlias x $ Alias (Name Nothing "u") Nothing) s+ sel1 = makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRAlias (TRSimple [Name Nothing "t"])+ $ Alias (Name Nothing "u") $ Just [Name Nothing "a", Name Nothing "b"]]}+ jsel = sel {msFrom =+ [TRParens $ TRJoin (TRSimple [Name Nothing "a"])+ False+ JInner+ (TRSimple [Name Nothing "b"])+ Nothing]}++{-+== 7.7 <joined table>++Function+Specify a table derived from a Cartesian product, inner join, or outer join.++<joined table> ::= <cross join> | <qualified join> | <natural join>++<cross join> ::= <table reference> CROSS JOIN <table factor>++<qualified join> ::=+ { <table reference> | <partitioned join table> }+ [ <join type> ] JOIN+ { <table reference> | <partitioned join table> }+ <join specification>++<partitioned join table> ::=+ <table factor> PARTITION BY+ <partitioned join column reference list>++<partitioned join column reference list> ::=+ <left paren> <partitioned join column reference>+ [ { <comma> <partitioned join column reference> }... ]+ <right paren>++<partitioned join column reference> ::= <column reference>++<natural join> ::=+ { <table reference> | <partitioned join table> }+ NATURAL [ <join type> ] JOIN+ { <table factor> | <partitioned join table> }++<join specification> ::= <join condition> | <named columns join>++<join condition> ::= ON <search condition>++<named columns join> ::= USING <left paren> <join column list> <right paren>++<join type> ::= INNER | <outer join type> [ OUTER ]++<outer join type> ::= LEFT | RIGHT | FULL++<join column list> ::= <column name list>+-}++joinedTable :: TestItem+joinedTable = Group "joined table"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select * from a cross join b"+ ,sel $ TRJoin a False JCross b Nothing)+ ,("select * from a join b on true"+ ,sel $ TRJoin a False JInner b+ (Just $ JoinOn $ Iden [Name Nothing "true"]))+ ,("select * from a join b using (c)"+ ,sel $ TRJoin a False JInner b+ (Just $ JoinUsing [Name Nothing "c"]))+ ,("select * from a inner join b on true"+ ,sel $ TRJoin a False JInner b+ (Just $ JoinOn $ Iden [Name Nothing "true"]))+ ,("select * from a left join b on true"+ ,sel $ TRJoin a False JLeft b+ (Just $ JoinOn $ Iden [Name Nothing "true"]))+ ,("select * from a left outer join b on true"+ ,sel $ TRJoin a False JLeft b+ (Just $ JoinOn $ Iden [Name Nothing "true"]))+ ,("select * from a right join b on true"+ ,sel $ TRJoin a False JRight b+ (Just $ JoinOn $ Iden [Name Nothing "true"]))+ ,("select * from a full join b on true"+ ,sel $ TRJoin a False JFull b+ (Just $ JoinOn $ Iden [Name Nothing "true"]))+ ,("select * from a natural join b"+ ,sel $ TRJoin a True JInner b Nothing)+ ,("select * from a natural inner join b"+ ,sel $ TRJoin a True JInner b Nothing)+ ,("select * from a natural left join b"+ ,sel $ TRJoin a True JLeft b Nothing)+ ,("select * from a natural left outer join b"+ ,sel $ TRJoin a True JLeft b Nothing)+ ,("select * from a natural right join b"+ ,sel $ TRJoin a True JRight b Nothing)+ ,("select * from a natural full join b"+ ,sel $ TRJoin a True JFull b Nothing)+ ]+ where+ sel t = toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [t]}+ a = TRSimple [Name Nothing "a"]+ b = TRSimple [Name Nothing "b"]++{-+TODO: partitioned joins++== 7.8 <where clause>++Function++Specify a table derived by the application of a <search condition> to+the result of the preceding <from clause>.++<where clause> ::= WHERE <search condition>+-}++whereClause :: TestItem+whereClause = Group "where clause"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select * from t where a = 5"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})]++{-+== 7.9 <group by clause>++Function++Specify a grouped table derived by the application of the <group by+clause> to the result of the previously specified clause.++<group by clause> ::= GROUP BY [ <set quantifier> ] <grouping element list>++<grouping element list> ::=+ <grouping element> [ { <comma> <grouping element> }... ]++<grouping element> ::=+ <ordinary grouping set>+ | <rollup list>+ | <cube list>+ | <grouping sets specification>+ | <empty grouping set>++<ordinary grouping set> ::=+ <grouping column reference>+ | <left paren> <grouping column reference list> <right paren>++<grouping column reference> ::= <column reference> [ <collate clause> ]++<grouping column reference list> ::=+ <grouping column reference> [ { <comma> <grouping column reference> }... ]++<rollup list> ::=+ ROLLUP <left paren> <ordinary grouping set list> <right paren>++<ordinary grouping set list> ::=+ <ordinary grouping set> [ { <comma> <ordinary grouping set> }... ]++<cube list> ::= CUBE <left paren> <ordinary grouping set list> <right paren>++<grouping sets specification> ::=+ GROUPING SETS <left paren> <grouping set list> <right paren>++<grouping set list> ::= <grouping set> [ { <comma> <grouping set> }... ]++<grouping set> ::=+ <ordinary grouping set>+ | <rollup list>+ | <cube list>+ | <grouping sets specification>+ | <empty grouping set>++<empty grouping set> ::= <left paren> <right paren>+-}+++groupByClause :: TestItem+groupByClause = Group "group by clause"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select a,sum(x) from t group by a"+ ,toQueryExpr $ ms [SimpleGroup $ Iden [Name Nothing "a"]])+ ,("select a,sum(x) from t group by a collate c"+ ,toQueryExpr $ ms [SimpleGroup $ Collate (Iden [Name Nothing "a"]) [Name Nothing "c"]])+ ,("select a,b,sum(x) from t group by a,b"+ ,toQueryExpr $ msx [SimpleGroup $ Iden [Name Nothing "a"]+ ,SimpleGroup $ Iden [Name Nothing "b"]])+ -- todo: group by set quantifier+ --,("select a,sum(x) from t group by distinct a"+ --,undefined)+ --,("select a,sum(x) from t group by all a"+ -- ,undefined)+ ,("select a,b,sum(x) from t group by rollup(a,b)"+ ,toQueryExpr $ msx [Rollup [SimpleGroup $ Iden [Name Nothing "a"]+ ,SimpleGroup $ Iden [Name Nothing "b"]]])+ ,("select a,b,sum(x) from t group by cube(a,b)"+ ,toQueryExpr $ msx [Cube [SimpleGroup $ Iden [Name Nothing "a"]+ ,SimpleGroup $ Iden [Name Nothing "b"]]])+ ,("select a,b,sum(x) from t group by grouping sets((),(a,b))"+ ,toQueryExpr $ msx [GroupingSets [GroupingParens []+ ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]+ ,SimpleGroup $ Iden [Name Nothing "b"]]]])+ ,("select sum(x) from t group by ()"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = [GroupingParens []]})+ ]+ where+ ms g = makeSelect+ {msSelectList = [(Iden [Name Nothing "a"], Nothing)+ ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = g}+ msx g = makeSelect+ {msSelectList = [(Iden [Name Nothing "a"], Nothing)+ ,(Iden [Name Nothing "b"],Nothing)+ ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = g}++{-+== 7.10 <having clause>++Function++Specify a grouped table derived by the elimination of groups that do+not satisfy a <search condition>.++<having clause> ::= HAVING <search condition>+-}++havingClause :: TestItem+havingClause = Group "having clause"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select a,sum(x) from t group by a having sum(x) > 1000"+ ,toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "a"], Nothing)+ ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+ ,msHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "x"]])+ [Name Nothing ">"]+ (NumLit "1000")})+ ]++{-+== 7.11 <window clause>++Function+Specify one or more window definitions.++<window clause> ::= WINDOW <window definition list>++<window definition list> ::=+ <window definition> [ { <comma> <window definition> }... ]++<window definition> ::= <new window name> AS <window specification>++<new window name> ::= <window name>++<window specification> ::=+ <left paren> <window specification details> <right paren>++<window specification details> ::=+ [ <existing window name> ]+ [ <window partition clause> ]+ [ <window order clause> ]+ [ <window frame clause> ]++<existing window name> ::= <window name>++<window partition clause> ::=+ PARTITION BY <window partition column reference list>++<window partition column reference list> ::=+ <window partition column reference>+ [ { <comma> <window partition column reference> }... ]++<window partition column reference> ::= <column reference> [ <collate clause> ]++<window order clause> ::= ORDER BY <sort specification list>++<window frame clause> ::=+ <window frame units> <window frame extent>+ [ <window frame exclusion> ]++<window frame units> ::= ROWS | RANGE | GROUPS++<window frame extent> ::= <window frame start> | <window frame between>++<window frame start> ::=+ UNBOUNDED PRECEDING+ | <window frame preceding>+ | CURRENT ROW++<window frame preceding> ::= <unsigned value specification> PRECEDING++<window frame between> ::=+ BETWEEN <window frame bound 1> AND <window frame bound 2>++<window frame bound 1> ::= <window frame bound>++<window frame bound 2> ::= <window frame bound>++<window frame bound> ::=+ <window frame start>+ | UNBOUNDED FOLLOWING+ | <window frame following>++<window frame following> ::= <unsigned value specification> FOLLOWING++<window frame exclusion> ::=+ EXCLUDE CURRENT ROW+ | EXCLUDE GROUP+ | EXCLUDE TIES+ | EXCLUDE NO OTHERS+-}++windowClause :: TestItem+windowClause = Group "window clause"+ [-- todo: window clause+ ]++{-+== 7.12 <query specification>++Function+Specify a table derived from the result of a <table expression>.++<query specification> ::=+ SELECT [ <set quantifier> ] <select list> <table expression>++<select list> ::=+ <asterisk>+ | <select sublist> [ { <comma> <select sublist> }... ]++<select sublist> ::= <derived column> | <qualified asterisk>++<qualified asterisk> ::=+ <asterisked identifier chain> <period> <asterisk>+ | <all fields reference>++<asterisked identifier chain> ::=+ <asterisked identifier> [ { <period> <asterisked identifier> }... ]++<asterisked identifier> ::= <identifier>++<derived column> ::= <value expression> [ <as clause> ]++<as clause> ::= [ AS ] <column name>++<all fields reference> ::=+ <value expression primary> <period> <asterisk>+ [ AS <left paren> <all fields column name list> <right paren> ]++<all fields column name list> ::= <column name list>+-}++querySpecification :: TestItem+querySpecification = Group "query specification"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select a from t",toQueryExpr ms)+ ,("select all a from t",toQueryExpr $ ms {msSetQuantifier = All})+ ,("select distinct a from t",toQueryExpr $ ms {msSetQuantifier = Distinct})+ ,("select * from t", toQueryExpr $ ms {msSelectList = [(Star,Nothing)]})+ ,("select a.* from t"+ ,toQueryExpr $ ms {msSelectList = [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "."] Star+ ,Nothing)]})+ ,("select a b from t"+ ,toQueryExpr $ ms {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]})+ ,("select a as b from t"+ ,toQueryExpr $ ms {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]})+ ,("select a,b from t"+ ,toQueryExpr $ ms {msSelectList = [(Iden [Name Nothing "a"], Nothing)+ ,(Iden [Name Nothing "b"], Nothing)]})+ -- todo: all field reference alias+ --,("select * as (a,b) from t",undefined)+ ]+ where+ ms = makeSelect+ {msSelectList = [(Iden [Name Nothing "a"], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }++{-+== 7.13 <query expression>++Function+Specify a table.++<query expression> ::=+ [ <with clause> ] <query expression body>+ [ <order by clause> ] [ <result offset clause> ] [ <fetch first clause> ]++<with clause> ::= WITH [ RECURSIVE ] <with list>++<with list> ::= <with list element> [ { <comma> <with list element> }... ]++<with list element> ::=+ <query name> [ <left paren> <with column list> <right paren> ]+ AS <table subquery> [ <search or cycle clause> ]++<with column list> ::= <column name list>+-}++withQueryExpression :: TestItem+withQueryExpression= Group "with query expression"+ [-- todo: with query expression+ ]++{-+<query expression body> ::=+ <query term>+ | <query expression body> UNION [ ALL | DISTINCT ]+ [ <corresponding spec> ] <query term>+ | <query expression body> EXCEPT [ ALL | DISTINCT ]+ [ <corresponding spec> ] <query term>++<query term> ::=+ <query primary>+ | <query term> INTERSECT [ ALL | DISTINCT ]+ [ <corresponding spec> ] <query primary>++<query primary> ::=+ <simple table>+ | <left paren> <query expression body>+ [ <order by clause> ] [ <result offset clause> ] [ <fetch first clause> ]+ <right paren>+-}++setOpQueryExpression :: TestItem+setOpQueryExpression= Group "set operation query expression"+ $ map (uncurry (TestQueryExpr ansi2011))+ -- todo: complete setop query expression tests+ [{-("select * from t union select * from t"+ ,undefined)+ ,("select * from t union all select * from t"+ ,undefined)+ ,("select * from t union distinct select * from t"+ ,undefined)+ ,("select * from t union corresponding select * from t"+ ,undefined)+ ,("select * from t union corresponding by (a,b) select * from t"+ ,undefined)+ ,("select * from t except select * from t"+ ,undefined)+ ,("select * from t in intersect select * from t"+ ,undefined)-}+ ]++{-+TODO: tests for the associativity and precendence++TODO: not sure exactly where parens are allowed, we will allow them+everywhere++<simple table> ::=+ <query specification>+ | <table value constructor>+ | <explicit table>++<explicit table> ::= TABLE <table or query name>++<corresponding spec> ::=+ CORRESPONDING [ BY <left paren> <corresponding column list> <right paren> ]++<corresponding column list> ::= <column name list>+-}++explicitTableQueryExpression :: TestItem+explicitTableQueryExpression= Group "explicit table query expression"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("table t", Table [Name Nothing "t"])+ ]+++{-+<order by clause> ::= ORDER BY <sort specification list>++<result offset clause> ::= OFFSET <offset row count> { ROW | ROWS }++<fetch first clause> ::=+ FETCH { FIRST | NEXT } [ <fetch first quantity> ] { ROW | ROWS } { ONLY | WITH TIES }++<fetch first quantity> ::= <fetch first row count> | <fetch first percentage>++<offset row count> ::= <simple value specification>++<fetch first row count> ::= <simple value specification>++<fetch first percentage> ::= <simple value specification> PERCENT+-}++orderOffsetFetchQueryExpression :: TestItem+orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"+ $ map (uncurry (TestQueryExpr ansi2011))+ [-- todo: finish tests for order offset and fetch+ ("select a from t order by a"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])+ DirDefault NullsOrderDefault]})+ ,("select a from t offset 5 row"+ ,toQueryExpr $ ms {msOffset = Just $ NumLit "5"})+ ,("select a from t offset 5 rows"+ ,toQueryExpr $ ms {msOffset = Just $ NumLit "5"})+ ,("select a from t fetch first 5 row only"+ ,toQueryExpr $ ms {msFetchFirst = Just $ NumLit "5"})+ -- todo: support with ties and percent in fetch+ --,("select a from t fetch next 5 rows with ties"+ --,("select a from t fetch first 5 percent rows only"+ ]+ where+ ms = makeSelect+ {msSelectList = [(Iden [Name Nothing "a"], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }+++{-+== 7.14 <search or cycle clause>++Function++Specify the generation of ordering and cycle detection information in+the result of recursive query expressions.++<search or cycle clause> ::=+ <search clause>+ | <cycle clause>+ | <search clause> <cycle clause>++<search clause> ::= SEARCH <recursive search order> SET <sequence column>++<recursive search order> ::=+ DEPTH FIRST BY <column name list>+ | BREADTH FIRST BY <column name list>++<sequence column> ::= <column name>++<cycle clause> ::=+ CYCLE <cycle column list> SET <cycle mark column> TO <cycle mark value>+ DEFAULT <non-cycle mark value> USING <path column>++<cycle column list> ::= <cycle column> [ { <comma> <cycle column> }... ]++<cycle column> ::= <column name>++<cycle mark column> ::= <column name>++<path column> ::= <column name>++<cycle mark value> ::= <value expression>++<non-cycle mark value> ::= <value expression>+-}++searchOrCycleClause :: TestItem+searchOrCycleClause = Group "search or cycle clause"+ [-- todo: search or cycle clause+ ]++{-+== 7.15 <subquery>++Function++Specify a scalar value, a row, or a table derived from a <query+expression>.++<scalar subquery> ::= <subquery>++<row subquery> ::= <subquery>++<table subquery> ::= <subquery>++<subquery> ::= <left paren> <query expression> <right paren>+-}++scalarSubquery :: TestItem+scalarSubquery = Group "scalar subquery"+ [-- todo: scalar subquery+ ]++{-+= 8 Predicates++== 8.1 <predicate>++Function+Specify a condition that can be evaluated to give a boolean value.++<predicate> ::=+ <comparison predicate>+ | <between predicate>+ | <in predicate>+ | <like predicate>+ | <similar predicate>+ | <regex like predicate>+ | <null predicate>+ | <quantified comparison predicate>+ | <exists predicate>+ | <unique predicate>+ | <normalized predicate>+ | <match predicate>+ | <overlaps predicate>+ | <distinct predicate>+ | <member predicate>+ | <submultiset predicate>+ | <set predicate>+ | <type predicate>+ | <period predicate>+-}++predicates :: TestItem+predicates = Group "predicates"+ [comparisonPredicates+ ,betweenPredicate+ ,inPredicate+ ,likePredicate+ ,similarPredicate+ ,regexLikePredicate+ ,nullPredicate+ ,quantifiedComparisonPredicate+ ,existsPredicate+ ,uniquePredicate+ ,normalizedPredicate+ ,matchPredicate+ ,overlapsPredicate+ ,distinctPredicate+ ,memberPredicate+ ,submultisetPredicate+ ,setPredicate+ ,periodPredicate+ ]+++{-+== 8.1 <predicate>++No grammar++== 8.2 <comparison predicate>++Function+Specify a comparison of two row values.++<comparison predicate> ::= <row value predicand> <comparison predicate part 2>++<comparison predicate part 2> ::= <comp op> <row value predicand>++<comp op> ::=+ <equals operator>+ | <not equals operator>+ | <less than operator>+ | <greater than operator>+ | <less than or equals operator>+ | <greater than or equals operator>+-}++comparisonPredicates :: TestItem+comparisonPredicates = Group "comparison predicates"+ $ map (uncurry (TestScalarExpr ansi2011))+ $ map mkOp ["=", "<>", "<", ">", "<=", ">="]+ <> [("ROW(a) = ROW(b)"+ ,BinOp (App [Name Nothing "ROW"] [a])+ [Name Nothing "="]+ (App [Name Nothing "ROW"] [b]))+ ,("(a,b) = (c,d)"+ ,BinOp (SpecialOp [Name Nothing "rowctor"] [a,b])+ [Name Nothing "="]+ (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "c"], Iden [Name Nothing "d"]]))+ ]+ where+ mkOp nm = ("a " <> nm <> " b"+ ,BinOp a [Name Nothing nm] b)+ a = Iden [Name Nothing "a"]+ b = Iden [Name Nothing "b"]++{-+TODO: what other tests, more complex expressions with comparisons?++== 8.3 <between predicate>++Function+Specify a range comparison.++<between predicate> ::= <row value predicand> <between predicate part 2>++<between predicate part 2> ::=+ [ NOT ] BETWEEN [ ASYMMETRIC | SYMMETRIC ]+ <row value predicand> AND <row value predicand>+-}++betweenPredicate :: TestItem+betweenPredicate = Group "between predicate"+ [-- todo: between predicate+ ]++{-+== 8.4 <in predicate>++Function+Specify a quantified comparison.++<in predicate> ::= <row value predicand> <in predicate part 2>++<in predicate part 2> ::= [ NOT ] IN <in predicate value>++<in predicate value> ::=+ <table subquery>+ | <left paren> <in value list> <right paren>++<in value list> ::=+ <row value expression> [ { <comma> <row value expression> }... ]+-}++inPredicate :: TestItem+inPredicate = Group "in predicate"+ [-- todo: in predicate+ ]++{-+== 8.5 <like predicate>++Function+Specify a pattern-match comparison.++<like predicate> ::= <character like predicate> | <octet like predicate>++<character like predicate> ::=+ <row value predicand> <character like predicate part 2>++<character like predicate part 2> ::=+ [ NOT ] LIKE <character pattern> [ ESCAPE <escape character> ]++<character pattern> ::= <character value expression>++<escape character> ::= <character value expression>++<octet like predicate> ::= <row value predicand> <octet like predicate part 2>++<octet like predicate part 2> ::=+ [ NOT ] LIKE <octet pattern> [ ESCAPE <escape octet> ]++<octet pattern> ::= <binary value expression>++<escape octet> ::= <binary value expression>+-}++likePredicate :: TestItem+likePredicate = Group "like predicate"+ [-- todo: like predicate+ ]++{-+== 8.6 <similar predicate>++Function+Specify a character string similarity by means of a regular expression.++<similar predicate> ::= <row value predicand> <similar predicate part 2>++<similar predicate part 2> ::=+ [ NOT ] SIMILAR TO <similar pattern> [ ESCAPE <escape character> ]++<similar pattern> ::= <character value expression>++<regular expression> ::=+ <regular term>+ | <regular expression> <vertical bar> <regular term>++<regular term> ::= <regular factor> | <regular term> <regular factor>++<regular factor> ::=+ <regular primary>+ | <regular primary> <asterisk>+ | <regular primary> <plus sign>+ | <regular primary> <question mark>+ | <regular primary> <repeat factor>++<repeat factor> ::= <left brace> <low value> [ <upper limit> ] <right brace>++<upper limit> ::= <comma> [ <high value> ]++<low value> ::= <unsigned integer>++<high value> ::= <unsigned integer>++<regular primary> ::=+ <character specifier>+ | <percent>+ | <regular character set>+ | <left paren> <regular expression> <right paren>++<character specifier> ::= <non-escaped character> | <escaped character>++<non-escaped character> ::= !! See the Syntax Rules.++<escaped character> ::= !! See the Syntax Rules.++<regular character set> ::=+ <underscore>+ | <left bracket> <character enumeration>... <right bracket>+ | <left bracket> <circumflex> <character enumeration>... <right bracket>+ | <left bracket> <character enumeration include>...+ <circumflex> <character enumeration exclude>... <right bracket>++<character enumeration include> ::= <character enumeration>++<character enumeration exclude> ::= <character enumeration>++<character enumeration> ::=+ <character specifier>+ | <character specifier> <minus sign> <character specifier>+ | <left bracket> <colon> <regular character set identifier> <colon> <right bracket>++<regular character set identifier> ::= <identifier>+-}++similarPredicate :: TestItem+similarPredicate = Group "similar predicate"+ [-- todo: similar predicate+ ]+++{-+== 8.7 <regex like predicate>++Function+Specify a pattern-match comparison using an XQuery regular expression.++<regex like predicate> ::= <row value predicand> <regex like predicate part 2>++<regex like predicate part 2> ::=+ [ NOT ] LIKE_REGEX <XQuery pattern> [ FLAG <XQuery option flag> ]+-}++regexLikePredicate :: TestItem+regexLikePredicate = Group "regex like predicate"+ [-- todo: regex like predicate+ ]++{-+== 8.8 <null predicate>++Function+Specify a test for a null value.++<null predicate> ::= <row value predicand> <null predicate part 2>++<null predicate part 2> ::= IS [ NOT ] NULL+-}++nullPredicate :: TestItem+nullPredicate = Group "null predicate"+ [-- todo: null predicate+ ]++{-+== 8.9 <quantified comparison predicate>++Function+Specify a quantified comparison.++<quantified comparison predicate> ::=+ <row value predicand> <quantified comparison predicate part 2>++<quantified comparison predicate part 2> ::=+ <comp op> <quantifier> <table subquery>++<quantifier> ::= <all> | <some>++<all> ::= ALL++<some> ::= SOME | ANY+-}++quantifiedComparisonPredicate :: TestItem+quantifiedComparisonPredicate = Group "quantified comparison predicate"+ $ map (uncurry (TestScalarExpr ansi2011))++ [("a = any (select * from t)"+ ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPAny ms)+ ,("a <= some (select * from t)"+ ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPSome ms)+ ,("a > all (select * from t)"+ ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)+ ,("(a,b) <> all (select * from t)"+ ,QuantifiedComparison+ (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"]+ ,Iden [Name Nothing "b"]]) [Name Nothing "<>"] CPAll ms)+ ]+ where+ ms = toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}++{-+== 8.10 <exists predicate>++Function+Specify a test for a non-empty set.++<exists predicate> ::= EXISTS <table subquery>+-}++existsPredicate :: TestItem+existsPredicate = Group "exists predicate"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("exists(select * from t where a = 4)"+ ,SubQueryExpr SqExists+ $ toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4"))+ }+ )]++{-+== 8.11 <unique predicate>++Function+Specify a test for the absence of duplicate rows.++<unique predicate> ::= UNIQUE <table subquery>+-}++uniquePredicate :: TestItem+uniquePredicate = Group "unique predicate"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("unique(select * from t where a = 4)"+ ,SubQueryExpr SqUnique+ $ toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ ,msWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4"))+ }+ )]++{-+== 8.12 <normalized predicate>++Function+Determine whether a character string value is normalized.++<normalized predicate> ::= <row value predicand> <normalized predicate part 2>++<normalized predicate part 2> ::= IS [ NOT ] [ <normal form> ] NORMALIZED+-}++normalizedPredicate :: TestItem+normalizedPredicate = Group "normalized predicate"+ [-- todo: normalized predicate+ ]++{-+== 8.13 <match predicate>++Function+Specify a test for matching rows.++<match predicate> ::= <row value predicand> <match predicate part 2>++<match predicate part 2> ::=+ MATCH [ UNIQUE ] [ SIMPLE | PARTIAL | FULL ] <table subquery>+-}++matchPredicate :: TestItem+matchPredicate = Group "match predicate"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("a match (select a from t)"+ ,Match (Iden [Name Nothing "a"]) False $ toQueryExpr ms)+ ,("(a,b) match (select a,b from t)"+ ,Match (SpecialOp [Name Nothing "rowctor"]+ [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) False $ toQueryExpr msa)+ ,("(a,b) match unique (select a,b from t)"+ ,Match (SpecialOp [Name Nothing "rowctor"]+ [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) True $ toQueryExpr msa)+ ]+ where+ ms = makeSelect+ {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}+ msa = ms {msSelectList = msSelectList ms+ <> [(Iden [Name Nothing "b"],Nothing)]}++{-+TODO: simple, partial and full++== 8.14 <overlaps predicate>++Function+Specify a test for an overlap between two datetime periods.++<overlaps predicate> ::=+ <overlaps predicate part 1> <overlaps predicate part 2>++<overlaps predicate part 1> ::= <row value predicand 1>++<overlaps predicate part 2> ::= OVERLAPS <row value predicand 2>++<row value predicand 1> ::= <row value predicand>++<row value predicand 2> ::= <row value predicand>+-}++overlapsPredicate :: TestItem+overlapsPredicate = Group "overlaps predicate"+ [-- todo: overlaps predicate+ ]++{-+== 8.15 <distinct predicate>++Function+Specify a test of whether two row values are distinct++<distinct predicate> ::= <row value predicand 3> <distinct predicate part 2>++<distinct predicate part 2> ::=+ IS [ NOT ] DISTINCT FROM <row value predicand 4>++<row value predicand 3> ::= <row value predicand>++<row value predicand 4> ::= <row value predicand>+-}++distinctPredicate :: TestItem+distinctPredicate = Group "distinct predicate"+ [-- todo: distinct predicate+ ]++{-+== 8.16 <member predicate>++Function+Specify a test of whether a value is a member of a multiset.++<member predicate> ::= <row value predicand> <member predicate part 2>++<member predicate part 2> ::= [ NOT ] MEMBER [ OF ] <multiset value expression>+-}++memberPredicate :: TestItem+memberPredicate = Group "member predicate"+ [-- todo: member predicate+ ]++{-+== 8.17 <submultiset predicate>++Function+Specify a test of whether a multiset is a submultiset of another multiset.++<submultiset predicate> ::=+ <row value predicand> <submultiset predicate part 2>++<submultiset predicate part 2> ::=+ [ NOT ] SUBMULTISET [ OF ] <multiset value expression>+-}++submultisetPredicate :: TestItem+submultisetPredicate = Group "submultiset predicate"+ [-- todo: submultiset predicate+ ]++{-+== 8.18 <set predicate>++Function++Specify a test of whether a multiset is a set (that is, does not+contain any duplicates).++<set predicate> ::= <row value predicand> <set predicate part 2>++<set predicate part 2> ::= IS [ NOT ] A SET+-}++setPredicate :: TestItem+setPredicate = Group "set predicate"+ [-- todo: set predicate+ ]++{-+== 8.19 <type predicate>++Function+Specify a type test.++<type predicate> ::= <row value predicand> <type predicate part 2>++<type predicate part 2> ::=+ IS [ NOT ] OF <left paren> <type list> <right paren>++<type list> ::=+ <user-defined type specification>+ [ { <comma> <user-defined type specification> }... ]++<user-defined type specification> ::=+ <inclusive user-defined type specification>+ | <exclusive user-defined type specification>++<inclusive user-defined type specification> ::=+ <path-resolved user-defined type name>++<exclusive user-defined type specification> ::=+ ONLY <path-resolved user-defined type name>++TODO: type predicate++== 8.20 <period predicate>++Function+Specify a test to determine the relationship between periods.++<period predicate> ::=+ <period overlaps predicate>+ | <period equals predicate>+ | <period contains predicate>+ | <period precedes predicate>+ | <period succeeds predicate>+ | <period immediately precedes predicate>+ | <period immediately succeeds predicate>++<period overlaps predicate> ::=+ <period predicand 1> <period overlaps predicate part 2>++<period overlaps predicate part 2> ::= OVERLAPS <period predicand 2>++<period predicand 1> ::= <period predicand>++<period predicand 2> ::= <period predicand>++<period predicand> ::=+ <period reference>+ | PERIOD <left paren> <period start value> <comma> <period end value> <right paren>++<period reference> ::= <basic identifier chain>++<period start value> ::= <datetime value expression>++<period end value> ::= <datetime value expression>++<period equals predicate> ::=+ <period predicand 1> <period equals predicate part 2>++<period equals predicate part 2> ::= EQUALS <period predicand 2>++<period contains predicate> ::=+ <period predicand 1> <period contains predicate part 2>++<period contains predicate part 2> ::=+ CONTAINS <period or point-in-time predicand>++<period or point-in-time predicand> ::=+ <period predicand>+ | <datetime value expression>++<period precedes predicate> ::=+ <period predicand 1> <period precedes predicate part 2>++<period precedes predicate part 2> ::= PRECEDES <period predicand 2>++<period succeeds predicate> ::=+ <period predicand 1> <period succeeds predicate part 2>++<period succeeds predicate part 2> ::= SUCCEEDS <period predicand 2>++<period immediately precedes predicate> ::=+ <period predicand 1> <period immediately precedes predicate part 2>++<period immediately precedes predicate part 2> ::=+ IMMEDIATELY PRECEDES <period predicand 2>++<period immediately succeeds predicate> ::=+ <period predicand 1> <period immediately succeeds predicate part 2>++<period immediately succeeds predicate part 2> ::=+ IMMEDIATELY SUCCEEDS <period predicand 2>+-}++periodPredicate :: TestItem+periodPredicate = Group "period predicate"+ [-- todo: period predicate+ ]++{-+== 8.21 <search condition>++Function++Specify a condition that is True, False, or Unknown, depending on the+value of a <boolean value expression>.++<search condition> ::= <boolean value expression>++= 10 Additional common elements++== 10.1 <interval qualifier>++Function+Specify the precision of an interval data type.++<interval qualifier> ::= <start field> TO <end field> | <single datetime field>++<start field> ::=+ <non-second primary datetime field>+ [ <left paren> <interval leading field precision> <right paren> ]++<end field> ::=+ <non-second primary datetime field>+ | SECOND [ <left paren> <interval fractional seconds precision> <right paren> ]++<single datetime field> ::=+ <non-second primary datetime field>+ [ <left paren> <interval leading field precision> <right paren> ]+ | SECOND [ <left paren> <interval leading field precision>+ [ <comma> <interval fractional seconds precision> ] <right paren> ]++<primary datetime field> ::= <non-second primary datetime field> | SECOND++<non-second primary datetime field> ::= YEAR | MONTH | DAY | HOUR | MINUTE++<interval fractional seconds precision> ::= <unsigned integer>++<interval leading field precision> ::= <unsigned integer>+-}++intervalQualifier :: TestItem+intervalQualifier = Group "interval qualifier"+ [-- todo: interval qualifier+ ]++{-+todo: also test all of these in the typenames and in the interval+literal tests++== 10.2 <language clause>++Function+Specify a programming language.++<language clause> ::= LANGUAGE <language name>++<language name> ::= ADA | C | COBOL | FORTRAN | M | MUMPS | PASCAL | PLI | SQL++== 10.3 <path specification>++Function+Specify an order for searching for an SQL-invoked routine.++<path specification> ::= PATH <schema name list>++<schema name list> ::= <schema name> [ { <comma> <schema name> }... ]++== 10.4 <routine invocation>++Function+Invoke an SQL-invoked routine.++<routine invocation> ::= <routine name> <SQL argument list>++<routine name> ::= [ <schema name> <period> ] <qualified identifier>++<SQL argument list> ::=+ <left paren> [ <SQL argument> [ { <comma> <SQL argument> }... ] ] <right paren>++<SQL argument> ::=+ <value expression>+ | <generalized expression>+ | <target specification>+ | <contextually typed value specification>+ | <named argument specification>++<generalized expression> ::=+ <value expression> AS <path-resolved user-defined type name>++<named argument specification> ::=+ <SQL parameter name> <named argument assignment token>+ <named argument SQL argument>++<named argument SQL argument> ::=+ <value expression>+ | <target specification>+ | <contextually typed value specification>++== 10.5 <character set specification>++Function+Identify a character set.++<character set specification> ::=+ <standard character set name>+ | <implementation-defined character set name>+ | <user-defined character set name>++<standard character set name> ::= <character set name>++<implementation-defined character set name> ::= <character set name>++<user-defined character set name> ::= <character set name>++tested in the type names++== 10.6 <specific routine designator>++Function+Specify an SQL-invoked routine.++<specific routine designator> ::=+ SPECIFIC <routine type> <specific name>+ | <routine type> <member name> [ FOR <schema-resolved user-defined type name> ]++<routine type> ::=+ ROUTINE+ | FUNCTION+ | PROCEDURE+ | [ INSTANCE | STATIC | CONSTRUCTOR ] METHOD++<member name> ::= <member name alternatives> [ <data type list> ]++<member name alternatives> ::= <schema qualified routine name> | <method name>++<data type list> ::=+ <left paren> [ <data type> [ { <comma> <data type> }... ] ] <right paren>++== 10.7 <collate clause>++Function+Specify a default collation.++<collate clause> ::= COLLATE <collation name>+-}++collateClause :: TestItem+collateClause = Group "collate clause"+ $ map (uncurry (TestScalarExpr ansi2011))+ [("a collate my_collation"+ ,Collate (Iden [Name Nothing "a"]) [Name Nothing "my_collation"])]++{-+== 10.8 <constraint name definition> and <constraint characteristics>++Function+Specify the name of a constraint and its characteristics.++<constraint name definition> ::= CONSTRAINT <constraint name>++<constraint characteristics> ::=+ <constraint check time> [ [ NOT ] DEFERRABLE ] [ <constraint enforcement> ]+ | [ NOT ] DEFERRABLE [ <constraint check time> ] [ <constraint enforcement> ]+ | <constraint enforcement>++<constraint check time> ::= INITIALLY DEFERRED | INITIALLY IMMEDIATE++<constraint enforcement> ::= [ NOT ] ENFORCED++== 10.9 <aggregate function>++Function+Specify a value computed from a collection of rows.++<aggregate function> ::=+ COUNT <left paren> <asterisk> <right paren> [ <filter clause> ]+ | <general set function> [ <filter clause> ]+ | <binary set function> [ <filter clause> ]+ | <ordered set function> [ <filter clause> ]+ | <array aggregate function> [ <filter clause> ]++<general set function> ::=+ <set function type> <left paren> [ <set quantifier> ]+ <value expression> <right paren>++<set function type> ::= <computational operation>++<computational operation> ::=+ AVG+ | MAX+ | MIN+ | SUM+ | EVERY+ | ANY+ | SOME+ | COUNT+ | STDDEV_POP+ | STDDEV_SAMP+ | VAR_SAMP+ | VAR_POP+ | COLLECT+ | FUSION+ | INTERSECTION++<set quantifier> ::= DISTINCT | ALL++<filter clause> ::= FILTER <left paren> WHERE <search condition> <right paren>++<binary set function> ::=+ <binary set function type> <left paren> <dependent variable expression> <comma>+ <independent variable expression> <right paren>++<binary set function type> ::=+ COVAR_POP+ | COVAR_SAMP+ | CORR+ | REGR_SLOPE+ | REGR_INTERCEPT+ | REGR_COUNT+ | REGR_R2+ | REGR_AVGX+ | REGR_AVGY+ | REGR_SXX+ | REGR_SYY+ | REGR_SXY++<dependent variable expression> ::= <numeric value expression>++<independent variable expression> ::= <numeric value expression>++<ordered set function> ::=+ <hypothetical set function>+ | <inverse distribution function>++<hypothetical set function> ::=+ <rank function type> <left paren>+ <hypothetical set function value expression list> <right paren>+ <within group specification>++<within group specification> ::=+ WITHIN GROUP <left paren> ORDER BY <sort specification list> <right paren>++<hypothetical set function value expression list> ::=+ <value expression> [ { <comma> <value expression> }... ]++<inverse distribution function> ::=+ <inverse distribution function type> <left paren>+ <inverse distribution function argument> <right paren>+ <within group specification>++<inverse distribution function argument> ::= <numeric value expression>++<inverse distribution function type> ::= PERCENTILE_CONT | PERCENTILE_DISC++<array aggregate function> ::=+ ARRAY_AGG+ <left paren> <value expression> [ ORDER BY <sort specification list> ] <right paren>+-}++aggregateFunction :: TestItem+aggregateFunction = Group "aggregate function"+ $ map (uncurry (TestScalarExpr ansi2011)) $+ [("count(*)",App [Name Nothing "count"] [Star])+ ,("count(*) filter (where something > 5)"+ ,AggregateApp [Name Nothing "count"] SQDefault [Star] [] fil)++-- gsf++ ,("count(a)",App [Name Nothing "count"] [Iden [Name Nothing "a"]])+ ,("count(distinct a)"+ ,AggregateApp [Name Nothing "count"]+ Distinct+ [Iden [Name Nothing "a"]] [] Nothing)+ ,("count(all a)"+ ,AggregateApp [Name Nothing "count"]+ All+ [Iden [Name Nothing "a"]] [] Nothing)+ ,("count(all a) filter (where something > 5)"+ ,AggregateApp [Name Nothing "count"]+ All+ [Iden [Name Nothing "a"]] [] fil)+ ] <> concatMap mkSimpleAgg+ ["avg","max","min","sum"+ ,"every", "any", "some"+ ,"stddev_pop","stddev_samp","var_samp","var_pop"+ ,"collect","fusion","intersection"]++-- bsf++ <> concatMap mkBsf+ ["COVAR_POP","COVAR_SAMP","CORR","REGR_SLOPE"+ ,"REGR_INTERCEPT","REGR_COUNT","REGR_R2"+ ,"REGR_AVGX","REGR_AVGY"+ ,"REGR_SXX","REGR_SYY","REGR_SXY"]++-- osf++ <>+ [("rank(a,c) within group (order by b)"+ ,AggregateAppGroup [Name Nothing "rank"]+ [Iden [Name Nothing "a"], Iden [Name Nothing "c"]]+ ob)]+ <> map mkGp ["dense_rank","percent_rank"+ ,"cume_dist", "percentile_cont"+ ,"percentile_disc"]+ <> [("array_agg(a)", App [Name Nothing "array_agg"] [Iden [Name Nothing "a"]])+ ,("array_agg(a order by z)"+ ,AggregateApp [Name Nothing "array_agg"]+ SQDefault+ [Iden [Name Nothing "a"]]+ [SortSpec (Iden [Name Nothing "z"])+ DirDefault NullsOrderDefault]+ Nothing)]++ where+ fil = Just $ BinOp (Iden [Name Nothing "something"]) [Name Nothing ">"] (NumLit "5")+ ob = [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault]+ mkGp nm = (nm <> "(a) within group (order by b)"+ ,AggregateAppGroup [Name Nothing nm]+ [Iden [Name Nothing "a"]]+ ob)++ mkSimpleAgg nm =+ [(nm <> "(a)",App [Name Nothing nm] [Iden [Name Nothing "a"]])+ ,(nm <> "(distinct a)"+ ,AggregateApp [Name Nothing nm]+ Distinct+ [Iden [Name Nothing "a"]] [] Nothing)]+ mkBsf nm =+ [(nm <> "(a,b)",App [Name Nothing nm] [Iden [Name Nothing "a"],Iden [Name Nothing "b"]])+ ,(nm <> "(a,b) filter (where something > 5)"+ ,AggregateApp [Name Nothing nm]+ SQDefault+ [Iden [Name Nothing "a"],Iden [Name Nothing "b"]] [] fil)]++{-+== 10.10 <sort specification list>++Function+Specify a sort order.++<sort specification list> ::=+ <sort specification> [ { <comma> <sort specification> }... ]++<sort specification> ::=+ <sort key> [ <ordering specification> ] [ <null ordering> ]++<sort key> ::= <value expression>++<ordering specification> ::= ASC | DESC++<null ordering> ::=+ | NULLS LAST+ NULLS FIRST+-}++sortSpecificationList :: TestItem+sortSpecificationList = Group "sort specification list"+ $ map (uncurry (TestQueryExpr ansi2011))+ [("select * from t order by a"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])+ DirDefault NullsOrderDefault]})+ ,("select * from t order by a,b"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])+ DirDefault NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"])+ DirDefault NullsOrderDefault]})+ ,("select * from t order by a asc,b"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])+ Asc NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"])+ DirDefault NullsOrderDefault]})+ ,("select * from t order by a desc,b"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])+ Desc NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"])+ DirDefault NullsOrderDefault]})+ ,("select * from t order by a collate x desc,b"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec+ (Collate (Iden [Name Nothing "a"]) [Name Nothing "x"])+ Desc NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"])+ DirDefault NullsOrderDefault]})+ ,("select * from t order by 1,2"+ ,toQueryExpr $ ms {msOrderBy = [SortSpec (NumLit "1")+ DirDefault NullsOrderDefault+ ,SortSpec (NumLit "2")+ DirDefault NullsOrderDefault]})+ ]+ where+ ms = makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}
+ tests/Language/SQL/SimpleSQL/SQL2011Schema.hs view
@@ -0,0 +1,2158 @@++{-+Section 11 in Foundation++This module covers the tests for parsing schema and DDL statements.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.SQL2011Schema (sql2011SchemaTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++sql2011SchemaTests :: TestItem+sql2011SchemaTests = Group "sql 2011 schema tests"+ [+++{-+11.1 <schema definition>++<schema definition> ::=+ CREATE SCHEMA <schema name clause>+ [ <schema character set or path> ]+ [ <schema element>... ]+-}++ (TestStatement ansi2011 "create schema my_schema"+ $ CreateSchema [Name Nothing "my_schema"])++{-+todo: schema name can have .+schema name can be quoted iden or unicode quoted iden+add schema element support:+ create a list of schema elements+ then do pairwise combinations in schema element list to test+++<schema character set or path> ::=+ <schema character set specification>+ | <schema path specification>+ | <schema character set specification> <schema path specification>+ | <schema path specification> <schema character set specification>++<schema name clause> ::=+ <schema name>+ | AUTHORIZATION <schema authorization identifier>+ | <schema name> AUTHORIZATION <schema authorization identifier>++<schema authorization identifier> ::=+ <authorization identifier>++<schema character set specification> ::=+ DEFAULT CHARACTER SET <character set specification>++<schema path specification> ::=+ <path specification>++<schema element> ::=+ <table definition>+ | <view definition>+ | <domain definition>+ | <character set definition>+ | <collation definition>+ | <transliteration definition>+ | <assertion definition>+ | <trigger definition>+ | <user-defined type definition>+ | <user-defined cast definition>+ | <user-defined ordering definition>+ | <transform definition>+ | <schema routine>+ | <sequence generator definition>+ | <grant statement>+ | <role definition>+++11.2 <drop schema statement>++<drop schema statement> ::=+ DROP SCHEMA <schema name> <drop behavior>++<drop behavior> ::=+ CASCADE+ | RESTRICT+-}+++ ,(TestStatement ansi2011 "drop schema my_schema"+ $ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour)+ ,(TestStatement ansi2011 "drop schema my_schema cascade"+ $ DropSchema [Name Nothing "my_schema"] Cascade)+ ,(TestStatement ansi2011 "drop schema my_schema restrict"+ $ DropSchema [Name Nothing "my_schema"] Restrict)++{-+11.3 <table definition>+++<table definition> ::=+ CREATE [ <table scope> ] TABLE <table name> <table contents source>+ [ WITH <system versioning clause> ]+ [ ON COMMIT <table commit action> ROWS ]+-}++ ,(TestStatement ansi2011 "create table t (a int, b int);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []])+++{-+<table contents source> ::=+ <table element list>+ | <typed table clause>+ | <as subquery clause>++<table scope> ::=+ <global or local> TEMPORARY++<global or local> ::=+ GLOBAL+ | LOCAL++<system versioning clause> ::=+ SYSTEM VERSIONING++defintely skip++<table commit action> ::=+ PRESERVE+ | DELETE++defintely skip++<table element list> ::=+ <left paren> <table element> [ { <comma> <table element> }... ] <right paren>++<table element> ::=+ <column definition>+ | <table period definition>+ | <table constraint definition>+ | <like clause>++<typed table clause> ::=+ OF <path-resolved user-defined type name> [ <subtable clause> ]+ [ <typed table element list> ]++defintely skip++<typed table element list> ::=+ <left paren> <typed table element>+ [ { <comma> <typed table element> }... ] <right paren>++defintely skip++<typed table element> ::=+ <column options>+ | <table constraint definition>+ | <self-referencing column specification>++defintely skip++<self-referencing column specification> ::=+ REF IS <self-referencing column name> [ <reference generation> ]++defintely skip++<reference generation> ::=+ SYSTEM GENERATED+ | USER GENERATED+ | DERIVED++defintely skip++<self-referencing column name> ::=+ <column name>++defintely skip++<column options> ::=+ <column name> WITH OPTIONS <column option list>++defintely skip++<column option list> ::=+ [ <scope clause> ] [ <default clause> ] [ <column constraint definition>... ]++defintely skip++<subtable clause> ::=+ UNDER <supertable clause>++defintely skip++<supertable clause> ::=+ <supertable name>++defintely skip++<supertable name> ::=+ <table name>++defintely skip++<like clause> ::=+ LIKE <table name> [ <like options> ]++<like options> ::=+ <like option>...++<like option> ::=+ <identity option>+ | <column default option>+ | <generation option>++<identity option> ::=+ INCLUDING IDENTITY+ | EXCLUDING IDENTITY++<column default option> ::=+ INCLUDING DEFAULTS+ | EXCLUDING DEFAULTS++<generation option> ::=+ INCLUDING GENERATED+ | EXCLUDING GENERATED++<as subquery clause> ::=+ [ <left paren> <column name list> <right paren> ] AS <table subquery>+ <with or without data>++<with or without data> ::=+ WITH NO DATA+ | WITH DATA++<table period definition> ::=+ <system or application time period specification>+ <left paren> <period begin column name> <comma> <period end column name> <right paren>++defintely skip++<system or application time period specification> ::=+ <system time period specification>+ | <application time period specification>++defintely skip++<system time period specification> ::=+ PERIOD FOR SYSTEM_TIME++defintely skip++<application time period specification> ::=+ PERIOD FOR <application time period name>++defintely skip++<application time period name> ::=+ <identifier>++defintely skip++<period begin column name> ::=+ <column name>++defintely skip++<period end column name> ::=+ <column name>++defintely skip+++11.4 <column definition>++<column definition> ::=+ <column name> [ <data type or domain name> ]+ [ <default clause> | <identity column specification> | <generation clause>+ | <system time period start column specification>+ | <system time period end column specification> ]+ [ <column constraint definition>... ]+ [ <collate clause> ]++<data type or domain name> ::=+ <data type>+ | <domain name>++<system time period start column specification> ::=+ <timestamp generation rule> AS ROW START++defintely skip++<system time period end column specification> ::=+ <timestamp generation rule> AS ROW END++defintely skip++<timestamp generation rule> ::=+ GENERATED ALWAYS++defintely skip++<column constraint definition> ::=+ [ <constraint name definition> ] <column constraint> [ <constraint characteristics> ]++<column constraint> ::=+ NOT NULL+ | <unique specification>+ | <references specification>+ | <check constraint definition>+++can have more than one+whitespace separated++one constratint:+optional name: constraint [Name]+not null | unique | references | check+todo: constraint characteristics+-}+++ ,(TestStatement ansi2011+ "create table t (a int not null);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing ColNotNullConstraint]])++ ,(TestStatement ansi2011+ "create table t (a int constraint a_not_null not null);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]])++ ,(TestStatement ansi2011+ "create table t (a int unique);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing ColUniqueConstraint]])++ ,(TestStatement ansi2011+ "create table t (a int primary key);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing (ColPrimaryKeyConstraint False)]])++ ,(TestStatement ansi2011 { diAutoincrement = True }+ "create table t (a int primary key autoincrement);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing (ColPrimaryKeyConstraint True)]])++{-+references t(a,b)+ [ Full |partial| simepl]+ [perm: on update [cascade | set null | set default | restrict | no action]+ on delete ""+-}++ ,(TestStatement ansi2011+ "create table t (a int references u);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u(a));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u match full);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing MatchFull+ DefaultReferentialAction DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u match partial);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing MatchPartial+ DefaultReferentialAction DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u match simple);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing MatchSimple+ DefaultReferentialAction DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u on update cascade );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefCascade DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u on update set null );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefSetNull DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u on update set default );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefSetDefault DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u on update no action );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefNoAction DefaultReferentialAction]])++ ,(TestStatement ansi2011+ "create table t (a int references u on delete cascade );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ DefaultReferentialAction RefCascade]])+++ ,(TestStatement ansi2011+ "create table t (a int references u on update cascade on delete restrict );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefCascade RefRestrict]])++ ,(TestStatement ansi2011+ "create table t (a int references u on delete restrict on update cascade );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefCascade RefRestrict]])++{-+TODO: try combinations and permutations of column constraints and+options+-}+++ ,(TestStatement ansi2011+ "create table t (a int check (a>5));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+ [ColConstraintDef Nothing+ (ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]])++++++{-+<identity column specification> ::=+ GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY+ [ <left paren> <common sequence generator options> <right paren> ]+-}++ ,(TestStatement ansi2011 "create table t (a int generated always as identity);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+ (Just $ IdentityColumnSpec GeneratedAlways []) []])++ ,(TestStatement ansi2011 "create table t (a int generated by default as identity);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+ (Just $ IdentityColumnSpec GeneratedByDefault []) []])+++ ,(TestStatement ansi2011+ "create table t (a int generated always as identity\n\+ \ ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+ (Just $ IdentityColumnSpec GeneratedAlways+ [SGOStartWith 5+ ,SGOIncrementBy 5+ ,SGOMaxValue 500+ ,SGOMinValue 5+ ,SGOCycle]) []])++ ,(TestStatement ansi2011+ "create table t (a int generated always as identity\n\+ \ ( start with -4 no maxvalue no minvalue no cycle ));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+ (Just $ IdentityColumnSpec GeneratedAlways+ [SGOStartWith (-4)+ ,SGONoMaxValue+ ,SGONoMinValue+ ,SGONoCycle]) []])++{-+I think <common sequence generator options> is supposed to just+whitespace separated. In db2 it seems to be csv, but the grammar here+just seems to be whitespace separated, and it is just whitespace+separated in oracle... Not completely sure though. Usually db2 is+closer than oracle?++generated always (valueexpr)++<generation clause> ::=+ <generation rule> AS <generation expression>++<generation rule> ::=+ GENERATED ALWAYS++<generation expression> ::=+ <left paren> <value expression> <right paren>+-}++ ,(TestStatement ansi2011+ "create table t (a int, \n\+ \ a2 int generated always as (a * 2));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "a2") (TypeName [Name Nothing "int"])+ (Just $ GenerationClause+ (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []])++++{-+11.5 <default clause>++<default clause> ::=+ DEFAULT <default option>++<default option> ::=+ <literal>+ | <datetime value function>+ | USER+ | CURRENT_USER+ | CURRENT_ROLE+ | SESSION_USER+ | SYSTEM_USER+ | CURRENT_CATALOG+ | CURRENT_SCHEMA+ | CURRENT_PATH+ | <implicitly typed value specification>+-}+++ ,(TestStatement ansi2011 "create table t (a int default 0);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+ (Just $ DefaultClause $ NumLit "0") []])++++{-+11.6 <table constraint definition>++<table constraint definition> ::=+ [ <constraint name definition> ] <table constraint>+ [ <constraint characteristics> ]++<table constraint> ::=+ <unique constraint definition>+ | <referential constraint definition>+ | <check constraint definition>++11.7 <unique constraint definition>++<unique constraint definition> ::=+ <unique specification> <left paren> <unique column list> [ <comma> <without overlap+ specification> ] <right paren>+ | UNIQUE ( VALUE )++<unique specification> ::=+ UNIQUE+ | PRIMARY KEY++<unique column list> ::=+ <column name list>+-}++ ,(TestStatement ansi2011+ "create table t (a int, unique (a));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"]+ ])++ ,(TestStatement ansi2011+ "create table t (a int, constraint a_unique unique (a));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef (Just [Name Nothing "a_unique"]) $+ TableUniqueConstraint [Name Nothing "a"]+ ])++-- todo: test permutations of column defs and table constraints++ ,(TestStatement ansi2011+ "create table t (a int, b int, unique (a,b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef Nothing $+ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]+ ])++ ,(TestStatement ansi2011+ "create table t (a int, b int, primary key (a,b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef Nothing $+ TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"]+ ])+++{-+<without overlap specification> ::=+ <application time period name> WITHOUT OVERLAPS++defintely skip+++11.8 <referential constraint definition>++<referential constraint definition> ::=+ FOREIGN KEY <left paren> <referencing column list>+ [ <comma> <referencing period specification> ] <right paren>+ <references specification>+-}+++ ,(TestStatement ansi2011+ "create table t (a int, b int,\n\+ \ foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef Nothing $+ TableReferencesConstraint+ [Name Nothing "a", Name Nothing "b"]+ [Name Nothing "u"]+ (Just [Name Nothing "c", Name Nothing "d"])+ MatchFull RefCascade RefRestrict+ ])++ ,(TestStatement ansi2011+ "create table t (a int,\n\+ \ constraint tfku1 foreign key (a) references u);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef (Just [Name Nothing "tfku1"]) $+ TableReferencesConstraint+ [Name Nothing "a"]+ [Name Nothing "u"]+ Nothing DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction+ ])++ ,(TestStatement ansi2011 { diNonCommaSeparatedConstraints = True }+ "create table t (a int, b int,\n\+ \ foreign key (a) references u(c)\n\+ \ foreign key (b) references v(d));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef Nothing $+ TableReferencesConstraint+ [Name Nothing "a"]+ [Name Nothing "u"]+ (Just [Name Nothing "c"])+ DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction+ ,TableConstraintDef Nothing $+ TableReferencesConstraint+ [Name Nothing "b"]+ [Name Nothing "v"]+ (Just [Name Nothing "d"])+ DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction+ ])+++{-+<references specification> ::=+ REFERENCES <referenced table and columns>+ [ MATCH <match type> ] [ <referential triggered action> ]++<match type> ::=+ FULL+ | PARTIAL+ | SIMPLE++<referencing column list> ::=+ <column name list>++<referencing period specification> ::=+ PERIOD <application time period name>++defintely skip++<referenced table and columns> ::=+ <table name> [ <left paren> <referenced column list>+ [ <comma> <referenced period specification> ] <right paren> ]++<referenced column list> ::=+ <column name list>++<referenced period specification> ::=+ PERIOD <application time period name>++defintely skip++<referential triggered action> ::=+ <update rule> [ <delete rule> ]+ | <delete rule> [ <update rule> ]++<update rule> ::=+ ON UPDATE <referential action>++<delete rule> ::=+ ON DELETE <referential action>++<referential action> ::=+ CASCADE+ | SET NULL+ | SET DEFAULT+ | RESTRICT+ | NO ACTION++++11.9 <check constraint definition>++<check constraint definition> ::=+ CHECK <left paren> <search condition> <right paren>+-}++ ,(TestStatement ansi2011+ "create table t (a int, b int, \n\+ \ check (a > b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef Nothing $+ TableCheckConstraint+ (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))+ ])+++ ,(TestStatement ansi2011+ "create table t (a int, b int, \n\+ \ constraint agtb check (a > b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+ ,TableConstraintDef (Just [Name Nothing "agtb"]) $+ TableCheckConstraint+ (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))+ ])+++{-+TODO: lots more combos of table elements+and types and the other bits in a column def++11.10 <alter table statement>++<alter table statement> ::=+ ALTER TABLE <table name> <alter table action>++<alter table action> ::=+ <add column definition>+ | <alter column definition>+ | <drop column definition>+ | <add table constraint definition>+ | <alter table constraint definition>+ | <drop table constraint definition>+ | <add table period definition>+ | <drop table period definition>+ | <add system versioning clause>+ | <drop system versioning clause>++11.11 <add column definition>++<add column definition> ::=+ ADD [ COLUMN ] <column definition>++alter table t add column a int+alter table t add a int+alter table t add a int unique not null check (a>0)+-}++ ,(TestStatement ansi2011+ "alter table t add column a int"+ $ AlterTable [Name Nothing "t"] $ AddColumnDef+ $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+ )++{-+todo: more add column++11.12 <alter column definition>++<alter column definition> ::=+ ALTER [ COLUMN ] <column name> <alter column action>++<alter column action> ::=+ <set column default clause>+ | <drop column default clause>+ | <set column not null clause>+ | <drop column not null clause>+ | <add column scope clause>+ | <drop column scope clause>+ | <alter column data type clause>+ | <alter identity column specification>+ | <drop identity property clause>+ | <drop column generation expression clause>+++11.13 <set column default clause>++<set column default clause> ::=+ SET <default clause>+-}+++ ,(TestStatement ansi2011+ "alter table t alter column c set default 0"+ $ AlterTable [Name Nothing "t"] $ AlterColumnSetDefault (Name Nothing "c")+ $ NumLit "0")++{-+11.14 <drop column default clause>++<drop column default clause> ::=+ DROP DEFAULT+-}++ ,(TestStatement ansi2011+ "alter table t alter column c drop default"+ $ AlterTable [Name Nothing "t"] $ AlterColumnDropDefault (Name Nothing "c"))+++{-+11.15 <set column not null clause>++<set column not null clause> ::=+ SET NOT NULL+-}++ ,(TestStatement ansi2011+ "alter table t alter column c set not null"+ $ AlterTable [Name Nothing "t"] $ AlterColumnSetNotNull (Name Nothing "c"))++{-+11.16 <drop column not null clause>++<drop column not null clause> ::=+ DROP NOT NULL+-}++ ,(TestStatement ansi2011+ "alter table t alter column c drop not null"+ $ AlterTable [Name Nothing "t"] $ AlterColumnDropNotNull (Name Nothing "c"))++{-+11.17 <add column scope clause>++<add column scope clause> ::=+ ADD <scope clause>++11.18 <drop column scope clause>++<drop column scope clause> ::=+ DROP SCOPE <drop behavior>++11.19 <alter column data type clause>++<alter column data type clause> ::=+ SET DATA TYPE <data type>+-}++ ,(TestStatement ansi2011+ "alter table t alter column c set data type int;"+ $ AlterTable [Name Nothing "t"] $+ AlterColumnSetDataType (Name Nothing "c") (TypeName [Name Nothing "int"]))++++{-+11.20 <alter identity column specification>++<alter identity column specification> ::=+ <set identity column generation clause> [ <alter identity column option>... ]+ | <alter identity column option>...++<set identity column generation clause> ::=+ SET GENERATED { ALWAYS | BY DEFAULT }++so you have to write set generated for alter identity?+and you have to use always or by default++makes no sense: if you just want to restart you have to explicitly set+the always or by default? you can't just leave it unchanged?++you don't write as identity like with create table, this is wrong:++alter table t alter column c set generated always as identity++but these are ok?++alter table t alter column c set generated always++alter table t alter column c set generated by default++<alter identity column option> ::=+ <alter sequence generator restart option>+ | SET <basic sequence generator option>++alter table t alter column c set generated always restart+alter table t alter column c set generated always restart with 4++you can just write restart++but to write others you have to repeat set? each time?++alter table t alter column c set generated always set increment by 5 set minvalue 0 set maxvalue 5 set cycle restart with 5+(no set before the restart++in create table, it looks like this:++c int generated generated always as identity (increment by 5 minvalue 0 maxvalue 5 cycle restart with 5)++why gratuituous differences???++is there no way to do this:++alter table t alter column c set generated as (a * 3)+??++UPDATE: alter sequence uses same syntax as create sequence, which is+the same sytnax as identity in create table, so overrule the sql+standard and use the same syntax in alter identity.++PLAN: TODO++don't implement alter table alter column generated now++review the syntax for generated in db2, oracle, sql server, postgres, others?++observe which features are supported, and the consistency between+create table and alter table++try to find some people to ask if the standard really is this much of+a mess or I have misunderstood the grammer, or maybe there is a good+reason for the inconsistencies?+++11.21 <drop identity property clause>++<drop identity property clause> ::=+ DROP IDENTITY++alter table t alter column c drop identity++included in the generated plan above++11.22 <drop column generation expression clause>++<drop column generation expression clause> ::=+ DROP EXPRESSION++alter table t alter column c drop expression++included in the generated plan above+++11.23 <drop column definition>++<drop column definition> ::=+ DROP [ COLUMN ] <column name> <drop behavior>+-}++ ,(TestStatement ansi2011+ "alter table t drop column c"+ $ AlterTable [Name Nothing "t"] $+ DropColumn (Name Nothing "c") DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "alter table t drop c cascade"+ $ AlterTable [Name Nothing "t"] $+ DropColumn (Name Nothing "c") Cascade)++ ,(TestStatement ansi2011+ "alter table t drop c restrict"+ $ AlterTable [Name Nothing "t"] $+ DropColumn (Name Nothing "c") Restrict)++++{-+11.24 <add table constraint definition>++<add table constraint definition> ::=+ ADD <table constraint definition>+-}++ ,(TestStatement ansi2011+ "alter table t add constraint c unique (a,b)"+ $ AlterTable [Name Nothing "t"] $+ AddTableConstraintDef (Just [Name Nothing "c"])+ $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])++ ,(TestStatement ansi2011+ "alter table t add unique (a,b)"+ $ AlterTable [Name Nothing "t"] $+ AddTableConstraintDef Nothing+ $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])+++{-+11.25 <alter table constraint definition>+<alter table constraint definition> ::=+ ALTER CONSTRAINT <constraint name> <constraint enforcement>++todo++11.26 <drop table constraint definition>++<drop table constraint definition> ::=+ DROP CONSTRAINT <constraint name> <drop behavior>+-}++ ,(TestStatement ansi2011+ "alter table t drop constraint c"+ $ AlterTable [Name Nothing "t"] $+ DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "alter table t drop constraint c restrict"+ $ AlterTable [Name Nothing "t"] $+ DropTableConstraintDef [Name Nothing "c"] Restrict)++{-+11.27 <add table period definition>++<add table period definition> ::=+ ADD <table period definition> [ <add system time period column list> ]++defintely skip++<add system time period column list> ::=+ ADD [ COLUMN ] <column definition 1> ADD [ COLUMN ] <column definition 2>++defintely skip++<column definition 1> ::=+ <column definition>++defintely skip++<column definition 2> ::=+ <column definition>++defintely skip++11.28 <drop table period definition>++<drop table period definition> ::=+ DROP <system or application time period specification> <drop behavior>++defintely skip++11.29 <add system versioning clause>++<add system versioning clause> ::=+ ADD <system versioning clause>++defintely skip++11.30 <drop system versioning clause>++<drop system versioning clause> ::=+ DROP SYSTEM VERSIONING <drop behavior>++defintely skip++11.31 <drop table statement>++<drop table statement> ::=+ DROP TABLE <table name> <drop behavior>+-}++ ,(TestStatement ansi2011+ "drop table t"+ $ DropTable [Name Nothing "t"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "drop table t restrict"+ $ DropTable [Name Nothing "t"] Restrict)+++{-+11.32 <view definition>++<view definition> ::=+ CREATE [ RECURSIVE ] VIEW <table name> <view specification>+ AS <query expression> [ WITH [ <levels clause> ] CHECK OPTION ]++<view specification> ::=+ <regular view specification>+ | <referenceable view specification>++<regular view specification> ::=+ [ <left paren> <view column list> <right paren> ]++<referenceable view specification> ::=+ OF <path-resolved user-defined type name> [ <subview clause> ]+ [ <view element list> ]++<subview clause> ::=+ UNDER <table name>++<view element list> ::=+ <left paren> <view element> [ { <comma> <view element> }... ] <right paren>++<view element> ::=+ <self-referencing column specification>+ | <view column option>++<view column option> ::=+ <column name> WITH OPTIONS <scope clause>++<levels clause> ::=+ CASCADED+ | LOCAL++<view column list> ::=+ <column name list>+-}++ ,(TestStatement ansi2011+ "create view v as select * from t"+ $ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) Nothing)+++ ,(TestStatement ansi2011+ "create recursive view v as select * from t"+ $ CreateView True [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) Nothing)++ ,(TestStatement ansi2011+ "create view v(a,b) as select * from t"+ $ CreateView False [Name Nothing "v"] (Just [Name Nothing "a", Name Nothing "b"])+ (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) Nothing)+++ ,(TestStatement ansi2011+ "create view v as select * from t with check option"+ $ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) (Just DefaultCheckOption))++ ,(TestStatement ansi2011+ "create view v as select * from t with cascaded check option"+ $ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) (Just CascadedCheckOption))++ ,(TestStatement ansi2011+ "create view v as select * from t with local check option"+ $ CreateView False [Name Nothing "v"] Nothing+ (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) (Just LocalCheckOption))+++{-+11.33 <drop view statement>++<drop view statement> ::=+ DROP VIEW <table name> <drop behavior>+-}+++ ,(TestStatement ansi2011+ "drop view v"+ $ DropView [Name Nothing "v"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "drop view v cascade"+ $ DropView [Name Nothing "v"] Cascade)+++{-+11.34 <domain definition>++<domain definition> ::=+ CREATE DOMAIN <domain name> [ AS ] <predefined type>+ [ <default clause> ]+ [ <domain constraint>... ]+ [ <collate clause> ]++<domain constraint> ::=+ [ <constraint name definition> ] <check constraint definition> [+ <constraint characteristics> ]+-}++ ,(TestStatement ansi2011+ "create domain my_int int"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ Nothing [])++ ,(TestStatement ansi2011+ "create domain my_int as int"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ Nothing [])++ ,(TestStatement ansi2011+ "create domain my_int int default 0"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ (Just (NumLit "0")) [])++ ,(TestStatement ansi2011+ "create domain my_int int check (value > 5)"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ Nothing [(Nothing+ ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])++ ,(TestStatement ansi2011+ "create domain my_int int constraint gt5 check (value > 5)"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ Nothing [(Just [Name Nothing "gt5"]+ ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])++++{-+11.35 <alter domain statement>++<alter domain statement> ::=+ ALTER DOMAIN <domain name> <alter domain action>++<alter domain action> ::=+ <set domain default clause>+ | <drop domain default clause>+ | <add domain constraint definition>+ | <drop domain constraint definition>++11.36 <set domain default clause>++<set domain default clause> ::=+ SET <default clause>+-}++ ,(TestStatement ansi2011+ "alter domain my_int set default 0"+ $ AlterDomain [Name Nothing "my_int"]+ $ ADSetDefault $ NumLit "0")+++{-+11.37 <drop domain default clause>++<drop domain default clause> ::=+ DROP DEFAULT+-}++ ,(TestStatement ansi2011+ "alter domain my_int drop default"+ $ AlterDomain [Name Nothing "my_int"]+ $ ADDropDefault)+++{-+11.38 <add domain constraint definition>++<add domain constraint definition> ::=+ ADD <domain constraint>+-}++ ,(TestStatement ansi2011+ "alter domain my_int add check (value > 6)"+ $ AlterDomain [Name Nothing "my_int"]+ $ ADAddConstraint Nothing+ $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))++ ,(TestStatement ansi2011+ "alter domain my_int add constraint gt6 check (value > 6)"+ $ AlterDomain [Name Nothing "my_int"]+ $ ADAddConstraint (Just [Name Nothing "gt6"])+ $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))+++{-+11.39 <drop domain constraint definition>++<drop domain constraint definition> ::=+ DROP CONSTRAINT <constraint name>+-}++ ,(TestStatement ansi2011+ "alter domain my_int drop constraint gt6"+ $ AlterDomain [Name Nothing "my_int"]+ $ ADDropConstraint [Name Nothing "gt6"])++{-+11.40 <drop domain statement>++<drop domain statement> ::=+ DROP DOMAIN <domain name> <drop behavior>+-}++ ,(TestStatement ansi2011+ "drop domain my_int"+ $ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "drop domain my_int cascade"+ $ DropDomain [Name Nothing "my_int"] Cascade)++++{-+11.41 <character set definition>++<character set definition> ::=+ CREATE CHARACTER SET <character set name> [ AS ]+ <character set source> [ <collate clause> ]++<character set source> ::=+ GET <character set specification>++11.42 <drop character set statement>++<drop character set statement> ::=+ DROP CHARACTER SET <character set name>++11.43 <collation definition>++<collation definition> ::=+ CREATE COLLATION <collation name> FOR <character set specification>+ FROM <existing collation name> [ <pad characteristic> ]++<existing collation name> ::=+ <collation name>++<pad characteristic> ::=+ NO PAD+ | PAD SPACE++11.44 <drop collation statement>++<drop collation statement> ::=+ DROP COLLATION <collation name> <drop behavior>++11.45 <transliteration definition>++<transliteration definition> ::=+ CREATE TRANSLATION <transliteration name> FOR <source character set specification>+ TO <target character set specification> FROM <transliteration source>++<source character set specification> ::=+ <character set specification>++<target character set specification> ::=+ <character set specification>++<transliteration source> ::=+ <existing transliteration name>+ | <transliteration routine>++<existing transliteration name> ::=+ <transliteration name>++<transliteration routine> ::=+ <specific routine designator>++11.46 <drop transliteration statement>++<drop transliteration statement> ::=+ DROP TRANSLATION <transliteration name>++11.47 <assertion definition>++<assertion definition> ::=+ CREATE ASSERTION <constraint name>+ CHECK <left paren> <search condition> <right paren>+ [ <constraint characteristics> ]+-}++ ,(TestStatement ansi2011+ "create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);"+ $ CreateAssertion [Name Nothing "t1_not_empty"]+ $ BinOp (SubQueryExpr SqSq $+ toQueryExpr $ makeSelect+ {msSelectList = [(App [Name Nothing "count"] [Star],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t1"]]+ })+ [Name Nothing ">"] (NumLit "0"))++{-+11.48 <drop assertion statement>++<drop assertion statement> ::=+ DROP ASSERTION <constraint name> [ <drop behavior> ]+-}++ ,(TestStatement ansi2011+ "drop assertion t1_not_empty;"+ $ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "drop assertion t1_not_empty cascade;"+ $ DropAssertion [Name Nothing "t1_not_empty"] Cascade)+++{-+11.49 <trigger definition>++<trigger definition> ::=+ CREATE TRIGGER <trigger name> <trigger action time> <trigger event>+ ON <table name> [ REFERENCING <transition table or variable list> ]+ <triggered action>++<trigger action time> ::=+ BEFORE+ | AFTER+ | INSTEAD OF++<trigger event> ::=+ INSERT+ | DELETE+ | UPDATE [ OF <trigger column list> ]++<trigger column list> ::=+ <column name list>++<triggered action> ::=+ [ FOR EACH { ROW | STATEMENT } ]+ [ <triggered when clause> ]+ <triggered SQL statement>++<triggered when clause> ::=+ WHEN <left paren> <search condition> <right paren>++<triggered SQL statement> ::=+ <SQL procedure statement>+ | BEGIN ATOMIC { <SQL procedure statement> <semicolon> }... END++<transition table or variable list> ::=+ <transition table or variable>...++<transition table or variable> ::=+ OLD [ ROW ] [ AS ] <old transition variable name>+ | NEW [ ROW ] [ AS ] <new transition variable name>+ | OLD TABLE [ AS ] <old transition table name>+ | NEW TABLE [ AS ] <new transition table name>++<old transition table name> ::=+ <transition table name>++<new transition table name> ::=+ <transition table name>++<transition table name> ::=+ <identifier>++<old transition variable name> ::=+ <correlation name>++<new transition variable name> ::=+ <correlation name>++11.50 <drop trigger statement>++<drop trigger statement> ::=+ DROP TRIGGER <trigger name>++11.51 <user-defined type definition>++<user-defined type definition> ::=+ CREATE TYPE <user-defined type body>++ <user-defined type body> ::=+ <schema-resolved user-defined type name>+ [ <subtype clause> ]+ [ AS <representation> ]+ [ <user-defined type option list> ]+ [ <method specification list> ]++<user-defined type option list> ::=+ <user-defined type option> [ <user-defined type option>... ]++<user-defined type option> ::=+ <instantiable clause>+ | <finality>+ | <reference type specification>+ | <cast to ref>+ | <cast to type>+ | <cast to distinct>+ | <cast to source>++<subtype clause> ::=+ UNDER <supertype name>++<supertype name> ::=+ <path-resolved user-defined type name>++<representation> ::=+ <predefined type>+ | <collection type>+ | <member list>++<member list> ::=+ <left paren> <member> [ { <comma> <member> }... ] <right paren>++<member> ::=+ <attribute definition>++<instantiable clause> ::=+ INSTANTIABLE+ | NOT INSTANTIABLE++<finality> ::=+ FINAL+ | NOT FINAL++<reference type specification> ::=+ <user-defined representation>+ | <derived representation>+ | <system-generated representation>++<user-defined representation> ::=+ REF USING <predefined type>++<derived representation> ::=+ REF FROM <list of attributes>++<system-generated representation> ::=+ REF IS SYSTEM GENERATED++<cast to ref> ::=+ CAST <left paren> SOURCE AS REF <right paren> WITH <cast to ref identifier>++<cast to ref identifier> ::=+ <identifier>++<cast to type> ::=+ CAST <left paren> REF AS SOURCE <right paren> WITH <cast to type identifier>++<cast to type identifier> ::=+ <identifier>++<list of attributes> ::=+ <left paren> <attribute name> [ { <comma> <attribute name> }... ] <right paren>++<cast to distinct> ::=+ CAST <left paren> SOURCE AS DISTINCT <right paren>+ WITH <cast to distinct identifier>++<cast to distinct identifier> ::=+ <identifier>++<cast to source> ::=+ CAST <left paren> DISTINCT AS SOURCE <right paren>+ WITH <cast to source identifier>++<cast to source identifier> ::=+ <identifier>++<method specification list> ::=+ <method specification> [ { <comma> <method specification> }... ]++<method specification> ::=+ <original method specification>+ | <overriding method specification>++<original method specification> ::=+ <partial method specification> [ SELF AS RESULT ] [ SELF AS LOCATOR ]+ [ <method characteristics> ]++<overriding method specification> ::=+ OVERRIDING <partial method specification>+ 1<partial method specification> ::=+ [ INSTANCE | STATIC | CONSTRUCTOR ]+ METHOD <method name> <SQL parameter declaration list>+ <returns clause>+ [ SPECIFIC <specific method name> ]++<specific method name> ::=+ [ <schema name> <period> ] <qualified identifier>++<method characteristics> ::=+ <method characteristic>...++ <method characteristic> ::=+ <language clause>+ | <parameter style clause>+ | <deterministic characteristic>+ | <SQL-data access indication>+ | <null-call clause>++11.52 <attribute definition>++<attribute definition> ::=+ <attribute name> <data type>+ [ <attribute default> ]+ [ <collate clause> ]++<attribute default> ::=+ <default clause>++11.53 <alter type statement>++<alter type statement> ::=+ ALTER TYPE <schema-resolved user-defined type name> <alter type action>++<alter type action> ::=+ <add attribute definition>+ | <drop attribute definition>+ | <add original method specification>+ | <add overriding method specification>+ | <drop method specification>++11.54 <add attribute definition>++<add attribute definition> ::=+ ADD ATTRIBUTE <attribute definition>++11.55 <drop attribute definition>++<drop attribute definition> ::=+ DROP ATTRIBUTE <attribute name> RESTRICT++11.56 <add original method specification>++<add original method specification> ::=+ ADD <original method specification>++11.57 <add overriding method specification>++<add overriding method specification> ::=+ ADD <overriding method specification>++11.58 <drop method specification>++<drop method specification> ::=+ DROP <specific method specification designator> RESTRICT++<specific method specification designator> ::=+ [ INSTANCE | STATIC | CONSTRUCTOR ]+ METHOD <method name> <data type list>++11.59 <drop data type statement>++<drop data type statement> ::=+ DROP TYPE <schema-resolved user-defined type name> <drop behavior>++11.60 <SQL-invoked routine>++<SQL-invoked routine> ::=+ <schema routine>++<schema routine> ::=+ <schema procedure>+ | <schema function>++<schema procedure> ::=+ CREATE <SQL-invoked procedure>++<schema function> ::=+ CREATE <SQL-invoked function>++<SQL-invoked procedure> ::=+ PROCEDURE <schema qualified routine name> <SQL parameter declaration list>+ <routine characteristics>+ <routine body>++<SQL-invoked function> ::=+ { <function specification> | <method specification designator> } <routine body>++<SQL parameter declaration list> ::=+ <left paren> [ <SQL parameter declaration>+ [ { <comma> <SQL parameter declaration> }... ] ] <right paren>++<SQL parameter declaration> ::=+ [ <parameter mode> ]+ [ <SQL parameter name> ]+ <parameter type> [ RESULT ]+ [ DEFAULT <parameter default> ]++<parameter default> ::=+ <value expression>+ | <contextually typed value specification>++<parameter mode> ::=+ IN+ | OUT+ | INOUT++<parameter type> ::=+ <data type> [ <locator indication> ]++<locator indication> ::=+ AS LOCATOR++<function specification> ::=+ FUNCTION <schema qualified routine name> <SQL parameter declaration list>+ <returns clause>+ <routine characteristics>+ [ <dispatch clause> ]++<method specification designator> ::=+ SPECIFIC METHOD <specific method name>+ | [ INSTANCE | STATIC | CONSTRUCTOR ]+ METHOD <method name> <SQL parameter declaration list>+ [ <returns clause> ]+ FOR <schema-resolved user-defined type name>++<routine characteristics> ::=+ [ <routine characteristic>... ]++<routine characteristic> ::=+ <language clause>+ | <parameter style clause>+ | SPECIFIC <specific name>+ | <deterministic characteristic>+ | <SQL-data access indication>+ | <null-call clause>+ | <returned result sets characteristic>+ | <savepoint level indication>++<savepoint level indication> ::=+ NEW SAVEPOINT LEVEL+ | OLD SAVEPOINT LEVEL++<returned result sets characteristic> ::=+ DYNAMIC RESULT SETS <maximum returned result sets>++<parameter style clause> ::=+ PARAMETER STYLE <parameter style>++<dispatch clause> ::=+ STATIC DISPATCH++<returns clause> ::=+ RETURNS <returns type>++<returns type> ::=+ <returns data type> [ <result cast> ]+ | <returns table type>++<returns table type> ::=+ TABLE <table function column list>++<table function column list> ::=+ <left paren> <table function column list element>+ [ { <comma> <table function column list element> }... ] <right paren>++<table function column list element> ::=+ <column name> <data type>++<result cast> ::=+ CAST FROM <result cast from type>++<result cast from type> ::=+ <data type> [ <locator indication> ]++<returns data type> ::=+ <data type> [ <locator indication> ]++<routine body> ::=+ <SQL routine spec>+ | <external body reference>++<SQL routine spec> ::=+ [ <rights clause> ] <SQL routine body>++<rights clause> ::=+ SQL SECURITY INVOKER+ | SQL SECURITY DEFINER++<SQL routine body> ::=+ <SQL procedure statement>++<external body reference> ::=+ EXTERNAL [ NAME <external routine name> ]+ [ <parameter style clause> ]+ [ <transform group specification> ]+ [ <external security clause> ]++<external security clause> ::=+ EXTERNAL SECURITY DEFINER+ | EXTERNAL SECURITY INVOKER+ | EXTERNAL SECURITY IMPLEMENTATION DEFINED++<parameter style> ::=+ SQL+ | GENERAL++<deterministic characteristic> ::=+ DETERMINISTIC+ | NOT DETERMINISTIC++<SQL-data access indication> ::=+ NO SQL+ | CONTAINS SQL+ | READS SQL DATA+ | MODIFIES SQL DATA++<null-call clause> ::=+ RETURNS NULL ON NULL INPUT+ | CALLED ON NULL INPUT++<maximum returned result sets> ::=+ <unsigned integer>++<transform group specification> ::=+ TRANSFORM GROUP { <single group specification> | <multiple group specification> }++<single group specification> ::=+ <group name>++<multiple group specification> ::=+ <group specification> [ { <comma> <group specification> }... ]++<group specification> ::=+ <group name> FOR TYPE <path-resolved user-defined type name>++11.61 <alter routine statement>++<alter routine statement> ::=+ ALTER <specific routine designator>+ <alter routine characteristics> <alter routine behavior>++<alter routine characteristics> ::=+ <alter routine characteristic>...++<alter routine characteristic> ::=+ <language clause>+ | <parameter style clause>+ | <SQL-data access indication>+ | <null-call clause>+ | <returned result sets characteristic>+ | NAME <external routine name>++<alter routine behavior> ::=+ RESTRICT++11.62 <drop routine statement>++<drop routine statement> ::=+ DROP <specific routine designator> <drop behavior>++11.63 <user-defined cast definition>++<user-defined cast definition> ::=+ CREATE CAST <left paren> <source data type> AS <target data type> <right paren>+ WITH <cast function>+ [ AS ASSIGNMENT ]++<cast function> ::=+ <specific routine designator>++<source data type> ::=+ <data type>++<target data type> ::=+ <data type>++11.64 <drop user-defined cast statement>++<drop user-defined cast statement> ::=+ DROP CAST <left paren> <source data type> AS <target data type> <right paren>+ <drop behavior>++11.65 <user-defined ordering definition>++<user-defined ordering definition> ::=+ CREATE ORDERING FOR <schema-resolved user-defined type name> <ordering form>++<ordering form> ::=+ <equals ordering form>+ | <full ordering form>++<equals ordering form> ::=+ EQUALS ONLY BY <ordering category>++<full ordering form> ::=+ ORDER FULL BY <ordering category>++<ordering category> ::=+ <relative category>+ | <map category>+ | <state category>++<relative category> ::=+ RELATIVE WITH <relative function specification>++<map category> ::=+ MAP WITH <map function specification>++<state category> ::=+ STATE [ <specific name> ]++<relative function specification> ::=+ <specific routine designator>++<map function specification> ::=+ <specific routine designator>++11.66 <drop user-defined ordering statement>++<drop user-defined ordering statement> ::=+ DROP ORDERING FOR <schema-resolved user-defined type name> <drop behavior>++11.67 <transform definition>++<transform definition> ::=+ CREATE { TRANSFORM | TRANSFORMS } FOR+ <schema-resolved user-defined type name> <transform group>...++<transform group> ::=+ <group name> <left paren> <transform element list> <right paren>++<group name> ::=+ <identifier>++<transform element list> ::=+ <transform element> [ <comma> <transform element> ]++<transform element> ::=+ <to sql>+ | <from sql>++<to sql> ::=+ TO SQL WITH <to sql function>++<from sql> ::=+ FROM SQL WITH <from sql function>++<to sql function> ::=+ <specific routine designator>++<from sql function> ::=+ <specific routine designator>++11.68 <alter transform statement>++<alter transform statement> ::=+ ALTER { TRANSFORM | TRANSFORMS }+ FOR <schema-resolved user-defined type name> <alter group>...++<alter group> ::=+ <group name> <left paren> <alter transform action list> <right paren>++<alter transform action list> ::=+ <alter transform action> [ { <comma> <alter transform action> }... ]++<alter transform action> ::=+ <add transform element list>+ | <drop transform element list>++11.69 <add transform element list>++<add transform element list> ::=+ ADD <left paren> <transform element list> <right paren>++11.70 <drop transform element list>++<drop transform element list> ::=+ DROP <left paren> <transform kind>+ [ <comma> <transform kind> ] <drop behavior> <right paren>++<transform kind> ::=+ TO SQL+ | FROM SQL++11.71 <drop transform statement>++<drop transform statement> ::=+ DROP { TRANSFORM | TRANSFORMS } <transforms to be dropped>+ FOR <schema-resolved user-defined type name> <drop behavior>++<transforms to be dropped> ::=+ ALL+ | <transform group element>++<transform group element> ::=+ <group name>++11.72 <sequence generator definition>++<sequence generator definition> ::=+ CREATE SEQUENCE <sequence generator name> [ <sequence generator options> ]++<sequence generator options> ::=+ <sequence generator option>...++<sequence generator option> ::=+ <sequence generator data type option>+ | <common sequence generator options>++<common sequence generator options> ::=+ <common sequence generator option>...++<common sequence generator option> ::=+ <sequence generator start with option>+ | <basic sequence generator option>++<basic sequence generator option> ::=+ <sequence generator increment by option>+ | <sequence generator maxvalue option>+ | <sequence generator minvalue option>+ | <sequence generator cycle option>++<sequence generator data type option> ::=+ AS <data type>++<sequence generator start with option> ::=+ START WITH <sequence generator start value>++<sequence generator start value> ::=+ <signed numeric literal>++<sequence generator increment by option> ::=+ INCREMENT BY <sequence generator increment>++<sequence generator increment> ::=+ <signed numeric literal>++<sequence generator maxvalue option> ::=+ MAXVALUE <sequence generator max value>+ | NO MAXVALUE++<sequence generator max value> ::=+ <signed numeric literal>++<sequence generator minvalue option> ::=+ MINVALUE <sequence generator min value>+ | NO MINVALUE++<sequence generator min value> ::=+ <signed numeric literal>++<sequence generator cycle option> ::=+ CYCLE+ | NO CYCLE+-}++ ,(TestStatement ansi2011+ "create sequence seq"+ $ CreateSequence [Name Nothing "seq"] [])++ ,(TestStatement ansi2011+ "create sequence seq as bigint"+ $ CreateSequence [Name Nothing "seq"]+ [SGODataType $ TypeName [Name Nothing "bigint"]])++ ,(TestStatement ansi2011+ "create sequence seq as bigint start with 5"+ $ CreateSequence [Name Nothing "seq"]+ [SGOStartWith 5+ ,SGODataType $ TypeName [Name Nothing "bigint"]+ ])+++{-+11.73 <alter sequence generator statement>++<alter sequence generator statement> ::=+ ALTER SEQUENCE <sequence generator name> <alter sequence generator options>++<alter sequence generator options> ::=+ <alter sequence generator option>...++<alter sequence generator option> ::=+ <alter sequence generator restart option>+ | <basic sequence generator option>++<alter sequence generator restart option> ::=+ RESTART [ WITH <sequence generator restart value> ]++<sequence generator restart value> ::=+ <signed numeric literal>+-}++ ,(TestStatement ansi2011+ "alter sequence seq restart"+ $ AlterSequence [Name Nothing "seq"]+ [SGORestart Nothing])++ ,(TestStatement ansi2011+ "alter sequence seq restart with 5"+ $ AlterSequence [Name Nothing "seq"]+ [SGORestart $ Just 5])++ ,(TestStatement ansi2011+ "alter sequence seq restart with 5 increment by 5"+ $ AlterSequence [Name Nothing "seq"]+ [SGORestart $ Just 5+ ,SGOIncrementBy 5])+++{-+11.74 <drop sequence generator statement>++<drop sequence generator statement> ::=+ DROP SEQUENCE <sequence generator name> <drop behavior>+-}++ ,(TestStatement ansi2011+ "drop sequence seq"+ $ DropSequence [Name Nothing "seq"] DefaultDropBehaviour)++ ,(TestStatement ansi2011+ "drop sequence seq restrict"+ $ DropSequence [Name Nothing "seq"] Restrict)+++ ]
+ tests/Language/SQL/SimpleSQL/ScalarExprs.hs view
@@ -0,0 +1,433 @@++-- Tests for parsing scalar expressions++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax++scalarExprTests :: TestItem+scalarExprTests = Group "scalarExprTests"+ [literals+ ,identifiers+ ,star+ ,parameter+ ,dots+ ,app+ ,caseexp+ ,convertfun + ,operators+ ,parens+ ,subqueries+ ,aggregates+ ,windowFunctions+ ,functionsWithReservedNames+ ]++literals :: TestItem+literals = Group "literals" $ map (uncurry (TestScalarExpr ansi2011))+ [("3", NumLit "3")+ ,("3.", NumLit "3.")+ ,("3.3", NumLit "3.3")+ ,(".3", NumLit ".3")+ ,("3.e3", NumLit "3.e3")+ ,("3.3e3", NumLit "3.3e3")+ ,(".3e3", NumLit ".3e3")+ ,("3e3", NumLit "3e3")+ ,("3e+3", NumLit "3e+3")+ ,("3e-3", NumLit "3e-3")+ ,("'string'", StringLit "'" "'" "string")+ ,("'string with a '' quote'", StringLit "'" "'" "string with a '' quote")+ ,("'1'", StringLit "'" "'" "1")+ ,("interval '3' day"+ ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)+ ,("interval '3' day (3)"+ ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing)+ ,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks")+ ]++identifiers :: TestItem+identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))+ [("iden1", Iden [Name Nothing "iden1"])+ --,("t.a", Iden2 "t" "a")+ ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])+ ,("\"from\"", Iden [Name (Just ("\"","\"")) "from"])+ ]++star :: TestItem+star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))+ [("*", Star)+ --,("t.*", Star2 "t")+ --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])+ ]++parameter :: TestItem+parameter = Group "parameter"+ [TestScalarExpr ansi2011 "?" Parameter+ ,TestScalarExpr postgres "$13" $ PositionalArg 13]+++dots :: TestItem+dots = Group "dot" $ map (uncurry (TestScalarExpr ansi2011))+ [("t.a", Iden [Name Nothing "t",Name Nothing "a"])+ ,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star)+ ,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"])+ ,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"])+ ]++app :: TestItem+app = Group "app" $ map (uncurry (TestScalarExpr ansi2011))+ [("f()", App [Name Nothing "f"] [])+ ,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]])+ ,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])+ ]++caseexp :: TestItem+caseexp = Group "caseexp" $ map (uncurry (TestScalarExpr ansi2011))+ [("case a when 1 then 2 end"+ ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]+ ,NumLit "2")] Nothing)++ ,("case a when 1 then 2 when 3 then 4 end"+ ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")+ ,([NumLit "3"], NumLit "4")] Nothing)++ ,("case a when 1 then 2 when 3 then 4 else 5 end"+ ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")+ ,([NumLit "3"], NumLit "4")]+ (Just $ NumLit "5"))++ ,("case when a=1 then 2 when a=3 then 4 else 5 end"+ ,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2")+ ,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")]+ (Just $ NumLit "5"))++ ,("case a when 1,2 then 10 when 3,4 then 20 end"+ ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"]+ ,NumLit "10")+ ,([NumLit "3",NumLit "4"]+ ,NumLit "20")]+ Nothing)++ ]++convertfun :: TestItem +convertfun = Group "convert" $ map (uncurry (TestScalarExpr sqlserver))+ [("CONVERT(varchar, 25.65)"+ ,Convert (TypeName [Name Nothing "varchar"]) (NumLit "25.65") Nothing)+ ,("CONVERT(datetime, '2017-08-25')"+ ,Convert (TypeName [Name Nothing "datetime"]) (StringLit "'" "'" "2017-08-25") Nothing)+ ,("CONVERT(varchar, '2017-08-25', 101)"+ ,Convert (TypeName [Name Nothing "varchar"]) (StringLit "'" "'" "2017-08-25") (Just 101))+ ]++operators :: TestItem+operators = Group "operators"+ [binaryOperators+ ,unaryOperators+ ,casts+ ,miscOps]++binaryOperators :: TestItem+binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+ [("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))+ -- sanity check fixities+ -- todo: add more fixity checking++ ,("a + b * c"+ ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]+ (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])))++ ,("a * b + c"+ ,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"]))+ [Name Nothing "+"] (Iden [Name Nothing "c"]))+ ]++unaryOperators :: TestItem+unaryOperators = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+ [("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])+ ,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])+ ,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"])+ ,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"])+ ]+++casts :: TestItem+casts = Group "operators" $ map (uncurry (TestScalarExpr ansi2011))+ [("cast('1' as int)"+ ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"])++ ,("int '3'"+ ,TypedLit (TypeName [Name Nothing "int"]) "3")++ ,("cast('1' as double precision)"+ ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])++ ,("cast('1' as float(8))"+ ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8)++ ,("cast('1' as decimal(15,2))"+ ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2)+++ ,("double precision '3'"+ ,TypedLit (TypeName [Name Nothing "double precision"]) "3")+ ]++subqueries :: TestItem+subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+ [("exists (select a from t)", SubQueryExpr SqExists ms)+ ,("(select a from t)", SubQueryExpr SqSq ms)++ ,("a in (select a from t)"+ ,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))++ ,("a not in (select a from t)"+ ,In False (Iden [Name Nothing "a"]) (InQueryExpr ms))++ ,("a > all (select a from t)"+ ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)++ ,("a = some (select a from t)"+ ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms)++ ,("a <= any (select a from t)"+ ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms)+ ]+ where+ ms = toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }++miscOps :: TestItem+miscOps = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+ [("a in (1,2,3)"+ ,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"])++ ,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"]))+ ,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"]))+ ,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"]))+ ,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"]))+ ,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"]))+ ,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"]))+ ,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"]))+ ,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"]))+ ,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"]))++ ,("a is not distinct from b"+ ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"]))++ ,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"]))+ ,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"]))+ ,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"]))++ ,("a is not similar to b"+ ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"]))++ ,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"]))+++-- special operators++ ,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]+ ,Iden [Name Nothing "b"]+ ,Iden [Name Nothing "c"]])++ ,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]+ ,Iden [Name Nothing "b"]+ ,Iden [Name Nothing "c"]])+ ,("(1,2)"+ ,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"])+++-- keyword special operators++ ,("extract(day from t)"+ , SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])++ ,("substring(x from 1 for 2)"+ ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")+ ,("for", NumLit "2")])++ ,("substring(x from 1)"+ ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")])++ ,("substring(x for 2)"+ ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")])++ ,("substring(x from 1 for 2 collate C)"+ ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"])+ [("from", NumLit "1")+ ,("for", Collate (NumLit "2") [Name Nothing "C"])])++-- this doesn't work because of a overlap in the 'in' parser++ ,("POSITION( string1 IN string2 )"+ ,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])])++ ,("CONVERT(char_value USING conversion_char_name)"+ ,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])+ [("using", Iden [Name Nothing "conversion_char_name"])])++ ,("TRANSLATE(char_value USING translation_name)"+ ,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"])+ [("using", Iden [Name Nothing "translation_name"])])++{-+OVERLAY(string PLACING embedded_string FROM start+[FOR length])+-}++ ,("OVERLAY(string PLACING embedded_string FROM start)"+ ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])+ [("placing", Iden [Name Nothing "embedded_string"])+ ,("from", Iden [Name Nothing "start"])])++ ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"+ ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])+ [("placing", Iden [Name Nothing "embedded_string"])+ ,("from", Iden [Name Nothing "start"])+ ,("for", Iden [Name Nothing "length"])])++{-+TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]+target_string+[COLLATE collation_name] )+-}++++ ,("trim(from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("both", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])])++ ,("trim(leading from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("leading", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])])++ ,("trim(trailing from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("trailing", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])])++ ,("trim(both from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("both", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])])+++ ,("trim(leading 'x' from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("leading", StringLit "'" "'" "x")+ ,("from", Iden [Name Nothing "target_string"])])++ ,("trim(trailing 'y' from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("trailing", StringLit "'" "'" "y")+ ,("from", Iden [Name Nothing "target_string"])])++ ,("trim(both 'z' from target_string collate C)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("both", StringLit "'" "'" "z")+ ,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])])++ ,("trim(leading from target_string)"+ ,SpecialOpK [Name Nothing "trim"] Nothing+ [("leading", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])])+++ ]++aggregates :: TestItem+aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))+ [("count(*)",App [Name Nothing "count"] [Star])++ ,("sum(a order by a)"+ ,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]+ [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing)++ ,("sum(all a)"+ ,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing)++ ,("count(distinct a)"+ ,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing)+ ]++windowFunctions :: TestItem+windowFunctions = Group "windowFunctions" $ map (uncurry (TestScalarExpr ansi2011))+ [("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing)+ ,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing)++ ,("max(a) over (partition by b)"+ ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing)++ ,("max(a) over (partition by b,c)"+ ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing)++ ,("sum(a) over (order by b)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []+ [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing)++ ,("sum(a) over (order by b desc,c)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []+ [SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)++ ,("sum(a) over (partition by b order by c)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)++ ,("sum(a) over (partition by b order by c range unbounded preceding)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+ $ Just $ FrameFrom FrameRange UnboundedPreceding)++ ,("sum(a) over (partition by b order by c range 5 preceding)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+ $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))++ ,("sum(a) over (partition by b order by c range current row)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+ $ Just $ FrameFrom FrameRange Current)++ ,("sum(a) over (partition by b order by c rows 5 following)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+ $ Just $ FrameFrom FrameRows $ Following (NumLit "5"))++ ,("sum(a) over (partition by b order by c range unbounded following)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+ $ Just $ FrameFrom FrameRange UnboundedFollowing)++ ,("sum(a) over (partition by b order by c \n\+ \range between 5 preceding and 5 following)"+ ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+ [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+ $ Just $ FrameBetween FrameRange+ (Preceding (NumLit "5"))+ (Following (NumLit "5")))++ ]++parens :: TestItem+parens = Group "parens" $ map (uncurry (TestScalarExpr ansi2011))+ [("(a)", Parens (Iden [Name Nothing "a"]))+ ,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])))+ ]++functionsWithReservedNames :: TestItem+functionsWithReservedNames = Group "functionsWithReservedNames" $ map t+ ["abs"+ ,"char_length"+ ]+ where+ t fn = TestScalarExpr ansi2011 (fn <> "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]+
+ tests/Language/SQL/SimpleSQL/TableRefs.hs view
@@ -0,0 +1,108 @@++{-+These are the tests for parsing focusing on the from part of query+expression+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+++tableRefTests :: TestItem+tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))+ [("select a from t"+ ,ms [TRSimple [Name Nothing "t"]])++ ,("select a from f(a)"+ ,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])++ ,("select a from t,u"+ ,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]])++ ,("select a from s.t"+ ,ms [TRSimple [Name Nothing "s", Name Nothing "t"]])++-- these lateral queries make no sense but the syntax is valid++ ,("select a from lateral a"+ ,ms [TRLateral $ TRSimple [Name Nothing "a"]])++ ,("select a from lateral a,b"+ ,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]])++ ,("select a from a, lateral b"+ ,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]])++ ,("select a from a natural join lateral b"+ ,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner+ (TRLateral $ TRSimple [Name Nothing "b"])+ Nothing])++ ,("select a from lateral a natural join lateral b"+ ,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner+ (TRLateral $ TRSimple [Name Nothing "b"])+ Nothing])+++ ,("select a from t inner join u on expr"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])+ (Just $ JoinOn $ Iden [Name Nothing "expr"])])++ ,("select a from t join u on expr"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])+ (Just $ JoinOn $ Iden [Name Nothing "expr"])])++ ,("select a from t left join u on expr"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"])+ (Just $ JoinOn $ Iden [Name Nothing "expr"])])++ ,("select a from t right join u on expr"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"])+ (Just $ JoinOn $ Iden [Name Nothing "expr"])])++ ,("select a from t full join u on expr"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"])+ (Just $ JoinOn $ Iden [Name Nothing "expr"])])++ ,("select a from t cross join u"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False+ JCross (TRSimple [Name Nothing "u"]) Nothing])++ ,("select a from t natural inner join u"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"])+ Nothing])++ ,("select a from t inner join u using(a,b)"+ ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])+ (Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])])++ ,("select a from (select a from t)"+ ,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]])++ ,("select a from t as u"+ ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])++ ,("select a from t u"+ ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])++ ,("select a from t u(b)"+ ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])])++ ,("select a from (t cross join u) as u"+ ,ms [TRAlias (TRParens $+ TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing)+ (Alias (Name Nothing "u") Nothing)])+ -- todo: not sure if the associativity is correct++ ,("select a from t cross join u cross join v",+ ms [TRJoin+ (TRJoin (TRSimple [Name Nothing "t"]) False+ JCross (TRSimple [Name Nothing "u"]) Nothing)+ False JCross (TRSimple [Name Nothing "v"]) Nothing])+ ]+ where+ ms f = toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]+ ,msFrom = f}
+ tests/Language/SQL/SimpleSQL/TestTypes.hs view
@@ -0,0 +1,45 @@++{-+This is the types used to define the tests as pure data. See the+Tests.hs module for the 'interpreter'.+-}++module Language.SQL.SimpleSQL.TestTypes+ (TestItem(..)+ ,module Language.SQL.SimpleSQL.Dialect+ ) where++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.Lex (Token)+import Language.SQL.SimpleSQL.Dialect++import Data.Text (Text)++{-+TODO: maybe make the dialect args into [dialect], then each test+checks all the dialects mentioned work, and all the dialects not+mentioned give a parse error. Not sure if this will be too awkward due+to lots of tricky exceptions/variationsx.+-}++data TestItem = Group Text [TestItem]+ | TestScalarExpr Dialect Text ScalarExpr+ | TestQueryExpr Dialect Text QueryExpr+ | TestStatement Dialect Text Statement+ | TestStatements Dialect Text [Statement]++{-+this just checks the sql parses without error, mostly just a+intermediate when I'm too lazy to write out the parsed AST. These+should all be TODO to convert to a testqueryexpr test.+-}++ | ParseQueryExpr Dialect Text++-- check that the string given fails to parse++ | ParseQueryExprFails Dialect Text+ | ParseScalarExprFails Dialect Text+ | LexTest Dialect Text [Token]+ | LexFails Dialect Text+ deriving (Eq,Show)
+ tests/Language/SQL/SimpleSQL/Tests.hs view
@@ -0,0 +1,180 @@++{-+This is the main tests module which exposes the test data plus the+Test.Framework tests. It also contains the code which converts the+test data to the Test.Framework tests.+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Tests+ (testData+ ,tests+ ,TestItem(..)+ ) where++import qualified Test.Tasty as T+import qualified Test.Tasty.HUnit as H++--import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.Pretty+import Language.SQL.SimpleSQL.Parse+import qualified Language.SQL.SimpleSQL.Lex as Lex++import Language.SQL.SimpleSQL.TestTypes++import Language.SQL.SimpleSQL.FullQueries+import Language.SQL.SimpleSQL.GroupBy+import Language.SQL.SimpleSQL.Postgres+import Language.SQL.SimpleSQL.QueryExprComponents+import Language.SQL.SimpleSQL.QueryExprs+import Language.SQL.SimpleSQL.TableRefs+import Language.SQL.SimpleSQL.ScalarExprs+import Language.SQL.SimpleSQL.Odbc+import Language.SQL.SimpleSQL.Tpch+import Language.SQL.SimpleSQL.LexerTests+import Language.SQL.SimpleSQL.EmptyStatement+import Language.SQL.SimpleSQL.CreateIndex++import Language.SQL.SimpleSQL.SQL2011Queries+import Language.SQL.SimpleSQL.SQL2011AccessControl+import Language.SQL.SimpleSQL.SQL2011Bits+import Language.SQL.SimpleSQL.SQL2011DataManipulation+import Language.SQL.SimpleSQL.SQL2011Schema++import Language.SQL.SimpleSQL.MySQL+import Language.SQL.SimpleSQL.Oracle+import Language.SQL.SimpleSQL.CustomDialect++import Data.Text (Text)+import qualified Data.Text as T+++{-+Order the tests to start from the simplest first. This is also the+order on the generated documentation.+-}++testData :: TestItem+testData =+ Group "parserTest"+ [lexerTests+ ,scalarExprTests+ ,odbcTests+ ,queryExprComponentTests+ ,queryExprsTests+ ,tableRefTests+ ,groupByTests+ ,fullQueriesTests+ ,postgresTests+ ,tpchTests+ ,sql2011QueryTests+ ,sql2011DataManipulationTests+ ,sql2011SchemaTests+ ,sql2011AccessControlTests+ ,sql2011BitsTests+ ,mySQLTests+ ,oracleTests+ ,customDialectTests+ ,emptyStatementTests+ ,createIndexTests+ ]++tests :: T.TestTree+tests = itemToTest testData++--runTests :: IO ()+--runTests = void $ H.runTestTT $ itemToTest testData++itemToTest :: TestItem -> T.TestTree+itemToTest (Group nm ts) =+ T.testGroup (T.unpack nm) $ map itemToTest ts+itemToTest (TestScalarExpr d str expected) =+ toTest parseScalarExpr prettyScalarExpr d str expected+itemToTest (TestQueryExpr d str expected) =+ toTest parseQueryExpr prettyQueryExpr d str expected+itemToTest (TestStatement d str expected) =+ toTest parseStatement prettyStatement d str expected+itemToTest (TestStatements d str expected) =+ toTest parseStatements prettyStatements d str expected+itemToTest (ParseQueryExpr d str) =+ toPTest parseQueryExpr prettyQueryExpr d str++itemToTest (ParseQueryExprFails d str) =+ toFTest parseQueryExpr prettyQueryExpr d str++itemToTest (ParseScalarExprFails d str) =+ toFTest parseScalarExpr prettyScalarExpr d str++itemToTest (LexTest d s ts) = makeLexerTest d s ts+itemToTest (LexFails d s) = makeLexingFailsTest d s++makeLexerTest :: Dialect -> Text -> [Lex.Token] -> T.TestTree+makeLexerTest d s ts = H.testCase (T.unpack s) $ do+ let ts1 = either (error . T.unpack . Lex.prettyError) id $ Lex.lexSQL d "" Nothing s+ H.assertEqual "" ts ts1+ let s' = Lex.prettyTokens d $ ts1+ H.assertEqual "pretty print" s s'++makeLexingFailsTest :: Dialect -> Text -> T.TestTree+makeLexingFailsTest d s = H.testCase (T.unpack s) $ do+ case Lex.lexSQL d "" Nothing s of+ Right x -> H.assertFailure $ "lexing should have failed: " ++ T.unpack s ++ "\ngot: " ++ show x+ Left _ -> pure ()+++toTest :: (Eq a, Show a) =>+ (Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a)+ -> (Dialect -> a -> Text)+ -> Dialect+ -> Text+ -> a+ -> T.TestTree+toTest parser pp d str expected = H.testCase (T.unpack str) $ do+ let egot = parser d "" Nothing str+ case egot of+ Left e -> H.assertFailure $ T.unpack $ prettyError e+ Right got -> H.assertEqual "" expected got+ + let str' = pp d expected+ egot' = parser d "" Nothing str'+ case egot' of+ Left e' ->+ H.assertFailure $ "pp roundtrip"+ ++ "\n" ++ (T.unpack str')+ ++ (T.unpack $ prettyError e')+ Right got' ->+ H.assertEqual+ ("pp roundtrip" ++ "\n" ++ T.unpack str')+ expected got'++toPTest :: (Eq a, Show a) =>+ (Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a)+ -> (Dialect -> a -> Text)+ -> Dialect+ -> Text+ -> T.TestTree+toPTest parser pp d str = H.testCase (T.unpack str) $ do+ let egot = parser d "" Nothing str+ case egot of+ Left e -> H.assertFailure $ T.unpack $ prettyError e+ Right got -> do+ let str' = pp d got+ let egot' = parser d "" Nothing str'+ case egot' of+ Left e' -> H.assertFailure $ "pp roundtrip "+ ++ "\n" ++ T.unpack str' ++ "\n"+ ++ T.unpack (prettyError e')+ Right _got' -> return ()++toFTest :: (Eq a, Show a) =>+ (Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a)+ -> (Dialect -> a -> Text)+ -> Dialect+ -> Text+ -> T.TestTree+toFTest parser _pp d str = H.testCase (T.unpack str) $ do+ let egot = parser d "" Nothing str+ case egot of+ Left _e -> return ()+ Right _got ->+ H.assertFailure $ "parse didn't fail: " ++ show d ++ "\n" ++ T.unpack str
+ tests/Language/SQL/SimpleSQL/Tpch.hs view
@@ -0,0 +1,688 @@++{-+Some tests for parsing the tpch queries++The changes made to the official syntax are:+1. replace the set rowcount with ansi standard fetch first n rows only+2. replace the create view, query, drop view sequence with a query+ using a common table expression+-}++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Tpch (tpchTests,tpchQueries) where++import Language.SQL.SimpleSQL.TestTypes++import Data.Text (Text)++tpchTests :: TestItem+tpchTests =+ Group "parse tpch"+ $ map (ParseQueryExpr ansi2011 . snd) tpchQueries++tpchQueries :: [(String,Text)]+tpchQueries =+ [("Q1","\n\+ \select\n\+ \ l_returnflag,\n\+ \ l_linestatus,\n\+ \ sum(l_quantity) as sum_qty,\n\+ \ sum(l_extendedprice) as sum_base_price,\n\+ \ sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,\n\+ \ sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,\n\+ \ avg(l_quantity) as avg_qty,\n\+ \ avg(l_extendedprice) as avg_price,\n\+ \ avg(l_discount) as avg_disc,\n\+ \ count(*) as count_order\n\+ \from\n\+ \ lineitem\n\+ \where\n\+ \ l_shipdate <= date '1998-12-01' - interval '63' day (3)\n\+ \group by\n\+ \ l_returnflag,\n\+ \ l_linestatus\n\+ \order by\n\+ \ l_returnflag,\n\+ \ l_linestatus")+ ,("Q2","\n\+ \select\n\+ \ s_acctbal,\n\+ \ s_name,\n\+ \ n_name,\n\+ \ p_partkey,\n\+ \ p_mfgr,\n\+ \ s_address,\n\+ \ s_phone,\n\+ \ s_comment\n\+ \from\n\+ \ part,\n\+ \ supplier,\n\+ \ partsupp,\n\+ \ nation,\n\+ \ region\n\+ \where\n\+ \ p_partkey = ps_partkey\n\+ \ and s_suppkey = ps_suppkey\n\+ \ and p_size = 15\n\+ \ and p_type like '%BRASS'\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_regionkey = r_regionkey\n\+ \ and r_name = 'EUROPE'\n\+ \ and ps_supplycost = (\n\+ \ select\n\+ \ min(ps_supplycost)\n\+ \ from\n\+ \ partsupp,\n\+ \ supplier,\n\+ \ nation,\n\+ \ region\n\+ \ where\n\+ \ p_partkey = ps_partkey\n\+ \ and s_suppkey = ps_suppkey\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_regionkey = r_regionkey\n\+ \ and r_name = 'EUROPE'\n\+ \ )\n\+ \order by\n\+ \ s_acctbal desc,\n\+ \ n_name,\n\+ \ s_name,\n\+ \ p_partkey\n\+ \fetch first 100 rows only")+ ,("Q3","\n\+ \ select\n\+ \ l_orderkey,\n\+ \ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\+ \ o_orderdate,\n\+ \ o_shippriority\n\+ \ from\n\+ \ customer,\n\+ \ orders,\n\+ \ lineitem\n\+ \ where\n\+ \ c_mktsegment = 'MACHINERY'\n\+ \ and c_custkey = o_custkey\n\+ \ and l_orderkey = o_orderkey\n\+ \ and o_orderdate < date '1995-03-21'\n\+ \ and l_shipdate > date '1995-03-21'\n\+ \ group by\n\+ \ l_orderkey,\n\+ \ o_orderdate,\n\+ \ o_shippriority\n\+ \ order by\n\+ \ revenue desc,\n\+ \ o_orderdate\n\+ \ fetch first 10 rows only")+ ,("Q4","\n\+ \ select\n\+ \ o_orderpriority,\n\+ \ count(*) as order_count\n\+ \ from\n\+ \ orders\n\+ \ where\n\+ \ o_orderdate >= date '1996-03-01'\n\+ \ and o_orderdate < date '1996-03-01' + interval '3' month\n\+ \ and exists (\n\+ \ select\n\+ \ *\n\+ \ from\n\+ \ lineitem\n\+ \ where\n\+ \ l_orderkey = o_orderkey\n\+ \ and l_commitdate < l_receiptdate\n\+ \ )\n\+ \ group by\n\+ \ o_orderpriority\n\+ \ order by\n\+ \ o_orderpriority")+ ,("Q5","\n\+ \ select\n\+ \ n_name,\n\+ \ sum(l_extendedprice * (1 - l_discount)) as revenue\n\+ \ from\n\+ \ customer,\n\+ \ orders,\n\+ \ lineitem,\n\+ \ supplier,\n\+ \ nation,\n\+ \ region\n\+ \ where\n\+ \ c_custkey = o_custkey\n\+ \ and l_orderkey = o_orderkey\n\+ \ and l_suppkey = s_suppkey\n\+ \ and c_nationkey = s_nationkey\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_regionkey = r_regionkey\n\+ \ and r_name = 'EUROPE'\n\+ \ and o_orderdate >= date '1997-01-01'\n\+ \ and o_orderdate < date '1997-01-01' + interval '1' year\n\+ \ group by\n\+ \ n_name\n\+ \ order by\n\+ \ revenue desc")+ ,("Q6","\n\+ \ select\n\+ \ sum(l_extendedprice * l_discount) as revenue\n\+ \ from\n\+ \ lineitem\n\+ \ where\n\+ \ l_shipdate >= date '1997-01-01'\n\+ \ and l_shipdate < date '1997-01-01' + interval '1' year\n\+ \ and l_discount between 0.07 - 0.01 and 0.07 + 0.01\n\+ \ and l_quantity < 24")+ ,("Q7","\n\+ \ select\n\+ \ supp_nation,\n\+ \ cust_nation,\n\+ \ l_year,\n\+ \ sum(volume) as revenue\n\+ \ from\n\+ \ (\n\+ \ select\n\+ \ n1.n_name as supp_nation,\n\+ \ n2.n_name as cust_nation,\n\+ \ extract(year from l_shipdate) as l_year,\n\+ \ l_extendedprice * (1 - l_discount) as volume\n\+ \ from\n\+ \ supplier,\n\+ \ lineitem,\n\+ \ orders,\n\+ \ customer,\n\+ \ nation n1,\n\+ \ nation n2\n\+ \ where\n\+ \ s_suppkey = l_suppkey\n\+ \ and o_orderkey = l_orderkey\n\+ \ and c_custkey = o_custkey\n\+ \ and s_nationkey = n1.n_nationkey\n\+ \ and c_nationkey = n2.n_nationkey\n\+ \ and (\n\+ \ (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')\n\+ \ or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')\n\+ \ )\n\+ \ and l_shipdate between date '1995-01-01' and date '1996-12-31'\n\+ \ ) as shipping\n\+ \ group by\n\+ \ supp_nation,\n\+ \ cust_nation,\n\+ \ l_year\n\+ \ order by\n\+ \ supp_nation,\n\+ \ cust_nation,\n\+ \ l_year")+ ,("Q8","\n\+ \ select\n\+ \ o_year,\n\+ \ sum(case\n\+ \ when nation = 'IRAQ' then volume\n\+ \ else 0\n\+ \ end) / sum(volume) as mkt_share\n\+ \ from\n\+ \ (\n\+ \ select\n\+ \ extract(year from o_orderdate) as o_year,\n\+ \ l_extendedprice * (1 - l_discount) as volume,\n\+ \ n2.n_name as nation\n\+ \ from\n\+ \ part,\n\+ \ supplier,\n\+ \ lineitem,\n\+ \ orders,\n\+ \ customer,\n\+ \ nation n1,\n\+ \ nation n2,\n\+ \ region\n\+ \ where\n\+ \ p_partkey = l_partkey\n\+ \ and s_suppkey = l_suppkey\n\+ \ and l_orderkey = o_orderkey\n\+ \ and o_custkey = c_custkey\n\+ \ and c_nationkey = n1.n_nationkey\n\+ \ and n1.n_regionkey = r_regionkey\n\+ \ and r_name = 'MIDDLE EAST'\n\+ \ and s_nationkey = n2.n_nationkey\n\+ \ and o_orderdate between date '1995-01-01' and date '1996-12-31'\n\+ \ and p_type = 'STANDARD ANODIZED BRASS'\n\+ \ ) as all_nations\n\+ \ group by\n\+ \ o_year\n\+ \ order by\n\+ \ o_year")+ ,("Q9","\n\+ \ select\n\+ \ nation,\n\+ \ o_year,\n\+ \ sum(amount) as sum_profit\n\+ \ from\n\+ \ (\n\+ \ select\n\+ \ n_name as nation,\n\+ \ extract(year from o_orderdate) as o_year,\n\+ \ l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount\n\+ \ from\n\+ \ part,\n\+ \ supplier,\n\+ \ lineitem,\n\+ \ partsupp,\n\+ \ orders,\n\+ \ nation\n\+ \ where\n\+ \ s_suppkey = l_suppkey\n\+ \ and ps_suppkey = l_suppkey\n\+ \ and ps_partkey = l_partkey\n\+ \ and p_partkey = l_partkey\n\+ \ and o_orderkey = l_orderkey\n\+ \ and s_nationkey = n_nationkey\n\+ \ and p_name like '%antique%'\n\+ \ ) as profit\n\+ \ group by\n\+ \ nation,\n\+ \ o_year\n\+ \ order by\n\+ \ nation,\n\+ \ o_year desc")+ ,("Q10","\n\+ \ select\n\+ \ c_custkey,\n\+ \ c_name,\n\+ \ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\+ \ c_acctbal,\n\+ \ n_name,\n\+ \ c_address,\n\+ \ c_phone,\n\+ \ c_comment\n\+ \ from\n\+ \ customer,\n\+ \ orders,\n\+ \ lineitem,\n\+ \ nation\n\+ \ where\n\+ \ c_custkey = o_custkey\n\+ \ and l_orderkey = o_orderkey\n\+ \ and o_orderdate >= date '1993-12-01'\n\+ \ and o_orderdate < date '1993-12-01' + interval '3' month\n\+ \ and l_returnflag = 'R'\n\+ \ and c_nationkey = n_nationkey\n\+ \ group by\n\+ \ c_custkey,\n\+ \ c_name,\n\+ \ c_acctbal,\n\+ \ c_phone,\n\+ \ n_name,\n\+ \ c_address,\n\+ \ c_comment\n\+ \ order by\n\+ \ revenue desc\n\+ \ fetch first 20 rows only")+ ,("Q11","\n\+ \ select\n\+ \ ps_partkey,\n\+ \ sum(ps_supplycost * ps_availqty) as value\n\+ \ from\n\+ \ partsupp,\n\+ \ supplier,\n\+ \ nation\n\+ \ where\n\+ \ ps_suppkey = s_suppkey\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_name = 'CHINA'\n\+ \ group by\n\+ \ ps_partkey having\n\+ \ sum(ps_supplycost * ps_availqty) > (\n\+ \ select\n\+ \ sum(ps_supplycost * ps_availqty) * 0.0001000000\n\+ \ from\n\+ \ partsupp,\n\+ \ supplier,\n\+ \ nation\n\+ \ where\n\+ \ ps_suppkey = s_suppkey\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_name = 'CHINA'\n\+ \ )\n\+ \ order by\n\+ \ value desc")+ ,("Q12","\n\+ \ select\n\+ \ l_shipmode,\n\+ \ sum(case\n\+ \ when o_orderpriority = '1-URGENT'\n\+ \ or o_orderpriority = '2-HIGH'\n\+ \ then 1\n\+ \ else 0\n\+ \ end) as high_line_count,\n\+ \ sum(case\n\+ \ when o_orderpriority <> '1-URGENT'\n\+ \ and o_orderpriority <> '2-HIGH'\n\+ \ then 1\n\+ \ else 0\n\+ \ end) as low_line_count\n\+ \ from\n\+ \ orders,\n\+ \ lineitem\n\+ \ where\n\+ \ o_orderkey = l_orderkey\n\+ \ and l_shipmode in ('AIR', 'RAIL')\n\+ \ and l_commitdate < l_receiptdate\n\+ \ and l_shipdate < l_commitdate\n\+ \ and l_receiptdate >= date '1994-01-01'\n\+ \ and l_receiptdate < date '1994-01-01' + interval '1' year\n\+ \ group by\n\+ \ l_shipmode\n\+ \ order by\n\+ \ l_shipmode")+ ,("Q13","\n\+ \ select\n\+ \ c_count,\n\+ \ count(*) as custdist\n\+ \ from\n\+ \ (\n\+ \ select\n\+ \ c_custkey,\n\+ \ count(o_orderkey)\n\+ \ from\n\+ \ customer left outer join orders on\n\+ \ c_custkey = o_custkey\n\+ \ and o_comment not like '%pending%requests%'\n\+ \ group by\n\+ \ c_custkey\n\+ \ ) as c_orders (c_custkey, c_count)\n\+ \ group by\n\+ \ c_count\n\+ \ order by\n\+ \ custdist desc,\n\+ \ c_count desc")+ ,("Q14","\n\+ \ select\n\+ \ 100.00 * sum(case\n\+ \ when p_type like 'PROMO%'\n\+ \ then l_extendedprice * (1 - l_discount)\n\+ \ else 0\n\+ \ end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue\n\+ \ from\n\+ \ lineitem,\n\+ \ part\n\+ \ where\n\+ \ l_partkey = p_partkey\n\+ \ and l_shipdate >= date '1994-12-01'\n\+ \ and l_shipdate < date '1994-12-01' + interval '1' month")+ ,("Q15","\n\+ \ /*create view revenue0 (supplier_no, total_revenue) as\n\+ \ select\n\+ \ l_suppkey,\n\+ \ sum(l_extendedprice * (1 - l_discount))\n\+ \ from\n\+ \ lineitem\n\+ \ where\n\+ \ l_shipdate >= date '1995-06-01'\n\+ \ and l_shipdate < date '1995-06-01' + interval '3' month\n\+ \ group by\n\+ \ l_suppkey;*/\n\+ \ with\n\+ \ revenue0 as\n\+ \ (select\n\+ \ l_suppkey as supplier_no,\n\+ \ sum(l_extendedprice * (1 - l_discount)) as total_revenue\n\+ \ from\n\+ \ lineitem\n\+ \ where\n\+ \ l_shipdate >= date '1995-06-01'\n\+ \ and l_shipdate < date '1995-06-01' + interval '3' month\n\+ \ group by\n\+ \ l_suppkey)\n\+ \ select\n\+ \ s_suppkey,\n\+ \ s_name,\n\+ \ s_address,\n\+ \ s_phone,\n\+ \ total_revenue\n\+ \ from\n\+ \ supplier,\n\+ \ revenue0\n\+ \ where\n\+ \ s_suppkey = supplier_no\n\+ \ and total_revenue = (\n\+ \ select\n\+ \ max(total_revenue)\n\+ \ from\n\+ \ revenue0\n\+ \ )\n\+ \ order by\n\+ \ s_suppkey")+ ,("Q16","\n\+ \ select\n\+ \ p_brand,\n\+ \ p_type,\n\+ \ p_size,\n\+ \ count(distinct ps_suppkey) as supplier_cnt\n\+ \ from\n\+ \ partsupp,\n\+ \ part\n\+ \ where\n\+ \ p_partkey = ps_partkey\n\+ \ and p_brand <> 'Brand#15'\n\+ \ and p_type not like 'MEDIUM BURNISHED%'\n\+ \ and p_size in (39, 26, 18, 45, 19, 1, 3, 9)\n\+ \ and ps_suppkey not in (\n\+ \ select\n\+ \ s_suppkey\n\+ \ from\n\+ \ supplier\n\+ \ where\n\+ \ s_comment like '%Customer%Complaints%'\n\+ \ )\n\+ \ group by\n\+ \ p_brand,\n\+ \ p_type,\n\+ \ p_size\n\+ \ order by\n\+ \ supplier_cnt desc,\n\+ \ p_brand,\n\+ \ p_type,\n\+ \ p_size")+ ,("Q17","\n\+ \ select\n\+ \ sum(l_extendedprice) / 7.0 as avg_yearly\n\+ \ from\n\+ \ lineitem,\n\+ \ part\n\+ \ where\n\+ \ p_partkey = l_partkey\n\+ \ and p_brand = 'Brand#52'\n\+ \ and p_container = 'JUMBO CAN'\n\+ \ and l_quantity < (\n\+ \ select\n\+ \ 0.2 * avg(l_quantity)\n\+ \ from\n\+ \ lineitem\n\+ \ where\n\+ \ l_partkey = p_partkey\n\+ \ )")+ ,("Q18","\n\+ \ select\n\+ \ c_name,\n\+ \ c_custkey,\n\+ \ o_orderkey,\n\+ \ o_orderdate,\n\+ \ o_totalprice,\n\+ \ sum(l_quantity)\n\+ \ from\n\+ \ customer,\n\+ \ orders,\n\+ \ lineitem\n\+ \ where\n\+ \ o_orderkey in (\n\+ \ select\n\+ \ l_orderkey\n\+ \ from\n\+ \ lineitem\n\+ \ group by\n\+ \ l_orderkey having\n\+ \ sum(l_quantity) > 313\n\+ \ )\n\+ \ and c_custkey = o_custkey\n\+ \ and o_orderkey = l_orderkey\n\+ \ group by\n\+ \ c_name,\n\+ \ c_custkey,\n\+ \ o_orderkey,\n\+ \ o_orderdate,\n\+ \ o_totalprice\n\+ \ order by\n\+ \ o_totalprice desc,\n\+ \ o_orderdate\n\+ \ fetch first 100 rows only")+ ,("Q19","\n\+ \ select\n\+ \ sum(l_extendedprice* (1 - l_discount)) as revenue\n\+ \ from\n\+ \ lineitem,\n\+ \ part\n\+ \ where\n\+ \ (\n\+ \ p_partkey = l_partkey\n\+ \ and p_brand = 'Brand#43'\n\+ \ and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')\n\+ \ and l_quantity >= 3 and l_quantity <= 3 + 10\n\+ \ and p_size between 1 and 5\n\+ \ and l_shipmode in ('AIR', 'AIR REG')\n\+ \ and l_shipinstruct = 'DELIVER IN PERSON'\n\+ \ )\n\+ \ or\n\+ \ (\n\+ \ p_partkey = l_partkey\n\+ \ and p_brand = 'Brand#25'\n\+ \ and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')\n\+ \ and l_quantity >= 10 and l_quantity <= 10 + 10\n\+ \ and p_size between 1 and 10\n\+ \ and l_shipmode in ('AIR', 'AIR REG')\n\+ \ and l_shipinstruct = 'DELIVER IN PERSON'\n\+ \ )\n\+ \ or\n\+ \ (\n\+ \ p_partkey = l_partkey\n\+ \ and p_brand = 'Brand#24'\n\+ \ and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')\n\+ \ and l_quantity >= 22 and l_quantity <= 22 + 10\n\+ \ and p_size between 1 and 15\n\+ \ and l_shipmode in ('AIR', 'AIR REG')\n\+ \ and l_shipinstruct = 'DELIVER IN PERSON'\n\+ \ )")+ ,("Q20","\n\+ \ select\n\+ \ s_name,\n\+ \ s_address\n\+ \ from\n\+ \ supplier,\n\+ \ nation\n\+ \ where\n\+ \ s_suppkey in (\n\+ \ select\n\+ \ ps_suppkey\n\+ \ from\n\+ \ partsupp\n\+ \ where\n\+ \ ps_partkey in (\n\+ \ select\n\+ \ p_partkey\n\+ \ from\n\+ \ part\n\+ \ where\n\+ \ p_name like 'lime%'\n\+ \ )\n\+ \ and ps_availqty > (\n\+ \ select\n\+ \ 0.5 * sum(l_quantity)\n\+ \ from\n\+ \ lineitem\n\+ \ where\n\+ \ l_partkey = ps_partkey\n\+ \ and l_suppkey = ps_suppkey\n\+ \ and l_shipdate >= date '1994-01-01'\n\+ \ and l_shipdate < date '1994-01-01' + interval '1' year\n\+ \ )\n\+ \ )\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_name = 'VIETNAM'\n\+ \ order by\n\+ \ s_name")+ ,("Q21","\n\+ \ select\n\+ \ s_name,\n\+ \ count(*) as numwait\n\+ \ from\n\+ \ supplier,\n\+ \ lineitem l1,\n\+ \ orders,\n\+ \ nation\n\+ \ where\n\+ \ s_suppkey = l1.l_suppkey\n\+ \ and o_orderkey = l1.l_orderkey\n\+ \ and o_orderstatus = 'F'\n\+ \ and l1.l_receiptdate > l1.l_commitdate\n\+ \ and exists (\n\+ \ select\n\+ \ *\n\+ \ from\n\+ \ lineitem l2\n\+ \ where\n\+ \ l2.l_orderkey = l1.l_orderkey\n\+ \ and l2.l_suppkey <> l1.l_suppkey\n\+ \ )\n\+ \ and not exists (\n\+ \ select\n\+ \ *\n\+ \ from\n\+ \ lineitem l3\n\+ \ where\n\+ \ l3.l_orderkey = l1.l_orderkey\n\+ \ and l3.l_suppkey <> l1.l_suppkey\n\+ \ and l3.l_receiptdate > l3.l_commitdate\n\+ \ )\n\+ \ and s_nationkey = n_nationkey\n\+ \ and n_name = 'INDIA'\n\+ \ group by\n\+ \ s_name\n\+ \ order by\n\+ \ numwait desc,\n\+ \ s_name\n\+ \ fetch first 100 rows only")+ ,("Q22","\n\+ \ select\n\+ \ cntrycode,\n\+ \ count(*) as numcust,\n\+ \ sum(c_acctbal) as totacctbal\n\+ \ from\n\+ \ (\n\+ \ select\n\+ \ substring(c_phone from 1 for 2) as cntrycode,\n\+ \ c_acctbal\n\+ \ from\n\+ \ customer\n\+ \ where\n\+ \ substring(c_phone from 1 for 2) in\n\+ \ ('41', '28', '39', '21', '24', '29', '44')\n\+ \ and c_acctbal > (\n\+ \ select\n\+ \ avg(c_acctbal)\n\+ \ from\n\+ \ customer\n\+ \ where\n\+ \ c_acctbal > 0.00\n\+ \ and substring(c_phone from 1 for 2) in\n\+ \ ('41', '28', '39', '21', '24', '29', '44')\n\+ \ )\n\+ \ and not exists (\n\+ \ select\n\+ \ *\n\+ \ from\n\+ \ orders\n\+ \ where\n\+ \ o_custkey = c_custkey\n\+ \ )\n\+ \ ) as custsale\n\+ \ group by\n\+ \ cntrycode\n\+ \ order by\n\+ \ cntrycode")+ ]
+ tests/RunTests.hs view
@@ -0,0 +1,8 @@+++import Test.Tasty++import Language.SQL.SimpleSQL.Tests++main :: IO ()+main = defaultMain tests
− tools/Fixity.lhs
@@ -1,702 +0,0 @@--= Fixity fixups--The point of this code is to be able to take a table of fixity-information for unary and binary operators, then adjust an ast to-match these fixities. The standard way of handling this is handling-fixities at the parsing stage.--For the SQL parser, this is difficult because there is lots of weird-syntax for operators (such as prefix and postfix multiple keyword-operators, between, etc.).--An alterative idea which is used in some places is to parse the tree-regarding all the operators to have the same precedence and left-associativity, then correct the fixity in a pass over the ast after-parsing. Would also like to use this to fix the fixity for the join-trees, and set operations, after parsing them. TODO: anything else?---Approach--Really not sure how to get this correct. So: lots of testing--Basic testing idea: create an expression, then write down manually how-the expression should parse with correct fixity. Can write down the-expression in concrete syntax, and the correct fixity version using-parens.--Then can parse the expression, fix it, parse the fixed expression,-remove the parens and compare them to make sure they are equal.--Second layer of testing. For each source expression parsed, run it-through a generator which will generate every version of that tree by-choosing all possibilities of fixities on a token by token basis. This-will ensure the fixity fixer is robust. An alternative approach is to-guarantee the parser will produce trees where all the fixities are-known (e.g. unary operators always bind tighter than binary, binary-are all left associative, prefix unary bind tighter than postfix. This-way, the fix code can make some assumptions and have less code. We-will stick with the full general version which is more robust.--Another testing approach is to parse the tree with our non fixity-respecting parser then fix it, and also parse it with a fixity-respecting expression parser, and check the results are the same. This-is difficult with the parsec build expression parser which doesn't-handle nested unary operators, so have to find or write another build-expression parser. We can test the fixer with simple operators (single-symbol prefix, postfix and binary ops) and then use it on the complex-sql ast trees.--Can also try to generate trees ala quickcheck/smallcheck, then check-them with the fixer and the build expression parser.--generate a tree:--start with a term-then roll dice:- add a prefix- add a postfix- do nothing-then roll dice- add a binary op- for the second arg, recurse the algo---algorithm:--consider possible cases:-binop with two binops args-binop with prefix on left-binop with postfix on right-postfix with prefix inside-prefix with postfix inside-postfix with binop inside-prefix with binop inside--write a function to deal with each case and try to compose--Tasks:--write unary op tests: on each other, and with binary ops-figure out how to generate trees-do the step one tests (write the fixity with parens)-check out parsers expression parser-see if can generate trees using smallcheck-try to test these trees against expression parser- otherwise, generate tree, generate variations, check fixity always-produces same result-----todo:--1. more tests for unary operators with each other-2. moving unary operators inside and outside binary operators:- have to think about how this will work in general case-3. ways to generate lots of tests and check them- -> what about creating a parser which parses to a list of all possible- parses with different fixities for each operator it sees?-4. ambiguous fixity cases - need position annotation to do these nicely-5. real sql: how to work with a variety of ast nodes-6. plug into simple-sql-parser-7. refactor the simple-sql-parser parsing code-8. simple-sql-parser todo for sqream: add other dml, dialects,- procedural?-9. testing idea: write big expressions with explicit parens everywhere- parse this- remove the parens- pretty print, then parse and fixfixity to see if same- then generate all variations of tree as if the fixities are different- and then fixfixity to check it restores the original---write fixity tests-write code to do the fixing-add error cases: put it in the either monad to report these--check the descend-then: move to real sql- different abstract representations of binops, etc.- what is the best way to deal with this? typeclass? conversion to and- from a generic tree?------can the binops be fixed on their own (precedence and assocativity)-and then the prefix and postfix ops in separate passes--what about a pass which puts the tree into canonical form:-all left associative, all unary ops tight as possible?-then the fixer can be easier?------> {-# LANGUAGE DeriveDataTypeable,TupleSections #-}-> import Data.Data--> import Text.Parsec.String (Parser)-> import Text.Parsec (try)-> import Text.Parsec.Char-> import Text.Parsec.Combinator-> import Text.Parsec (parse,ParseError)-> import Control.Applicative ((<|>),many) -- ((<**>),(<$>),(<*), (*>),(<*>), (<$), (<|>), many)-> --import qualified Text.Parsec.String.Expr as E-> import Control.Monad-> --import Data.List (intercalate)-> import Data.Maybe ()-> --import qualified Test.HUnit as H-> --import FunctionsAndTypesForParsing-> import Debug.Trace-> import Text.Show.Pretty-> import Data.List-> import Control.Applicative--> import qualified Test.Tasty as T-> import qualified Test.Tasty.HUnit as H---> data Expr = BinOp Expr String Expr-> | PrefOp String Expr-> | PostOp String Expr-> | Iden String-> | Lit String-> | App String [Expr]-> | Parens Expr-> deriving (Eq,Show,Data,Typeable)------------quick parser--> parensValue :: Parser Expr-> parensValue = Parens <$> parens valueExpr--> idenApp :: Parser Expr-> idenApp = try $ do-> i <- identifier-> guard (i `notElem` ["not", "and", "or", "is"])-> choice [do-> args <- parens (commaSep valueExpr)-> return $ App i args-> ,return $ Iden i-> ]--> lit :: Parser Expr-> lit = stringLit <|> numLit-> where-> stringLit = Lit <$> lexeme (char '\'' *> manyTill anyChar (char '\''))-> numLit = do-> x <- lexeme (many1 digit)-> let y :: Integer-> y = read x-> return $ Lit $ show y--> prefOp :: Parser Expr-> prefOp = sym <|> kw-> where-> sym = do-> let prefOps = ["+", "-"]-> s <- choice $ map symbol prefOps-> v <- term-> return $ PrefOp s v-> kw = do-> let prefOps = ["not"]-> i <- identifier-> guard (i `elem` prefOps)-> v <- term-> return $ PrefOp i v--> postOp :: Parser (Expr -> Expr)-> postOp = try $ do-> let kws = ["is null"]-> kwsp = map (\a -> try $ do-> let x :: [String]-> x = words a-> mapM_ keyword_ x-> return $ PostOp a-> ) kws-> choice kwsp--> binOp :: Parser (Expr -> Expr -> Expr)-> binOp = symbolBinOp <|> kwBinOp-> where-> symbolBinOp = do-> let binOps = ["+", "-", "*", "/"]-> s <- choice $ map symbol binOps-> return $ \a b -> BinOp a s b-> kwBinOp = do-> let kwBinOps = ["and", "or"]-> i <- identifier-> guard (i `elem` kwBinOps)-> return $ \a b -> BinOp a i b--> term :: Parser Expr-> term = (parensValue-> <|> try prefOp-> <|> idenApp-> <|> lit)-> <??*> postOp--> -- (<??>) :: Parser a -> Parser (a -> a) -> Parser a-> -- p <??> q = p <**> option id q--> (<??*>) :: Parser a -> Parser (a -> a) -> Parser a-> p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)--> valueExpr :: Parser Expr-> valueExpr = chainl1 term binOp---> parens :: Parser a -> Parser a-> parens = between openParen closeParen--> openParen :: Parser Char-> openParen = lexeme $ char '('-> closeParen :: Parser Char-> closeParen = lexeme $ char ')'--> symbol :: String -> Parser String-> symbol s = try $ lexeme $ do-> u <- many1 (oneOf "<>=+-^%/*!|")-> guard (s == u)-> return s--> identifier :: Parser String-> identifier = lexeme ((:) <$> firstChar <*> many nonFirstChar)-> where-> firstChar = letter <|> char '_'-> nonFirstChar = digit <|> firstChar--> keyword :: String -> Parser String-> keyword k = try $ do-> i <- identifier-> guard (i == k)-> return k--> keyword_ :: String -> Parser ()-> keyword_ = void . keyword--> whitespace :: Parser ()-> whitespace =-> choice [simpleWhitespace *> whitespace-> ,lineComment *> whitespace-> ,blockComment *> whitespace-> ,return ()]-> where-> lineComment = try (string "--")-> *> manyTill anyChar (void (char '\n') <|> eof)-> blockComment = try (string "/*")-> *> manyTill anyChar (try $ string "*/")-> simpleWhitespace = void $ many1 (oneOf " \t\n")-> lexeme :: Parser a -> Parser a-> lexeme p = p <* whitespace-> comma :: Parser Char-> comma = lexeme $ char ','--> commaSep :: Parser a -> Parser [a]-> commaSep = (`sepBy` comma)--> parseExpr :: String -> Either ParseError Expr-> parseExpr = parse (whitespace *> valueExpr <* eof) ""------------------> data Assoc = AssocLeft | AssocRight | AssocNone deriving (Eq,Show)--> type Fixities = [(String, (Int, Assoc))]--> fixFixity :: Fixities -> Expr -> Expr-> fixFixity fixities = fixBinOpPrecedence . fixBinOpAssociativity . fixNestedPrefPostPrec-> where-> fixBinOpAssociativity e = case e of-> BinOp a op b ->-> let a' = fixBinOpAssociativity a-> b' = fixBinOpAssociativity b-> def = BinOp a' op b'-> in case (a',b') of-> -- both-> -- a1 op1 a2 op b1 op2 b2-> (BinOp a1 op1 a2-> ,BinOp b1 op2 b2)-> | Just (_p,opa) <- lookupFixity op-> , Just (_p,op1a) <- lookupFixity op1-> , Just (_p,op2a) <- lookupFixity op2-> -> case (opa, op1a, op2a) of-> (AssocRight, AssocRight, AssocRight) ->-> BinOp a1 op1 (BinOp a2 op (BinOp b1 op2 b2))-> (AssocLeft, AssocLeft, AssocLeft) ->-> BinOp (BinOp (BinOp a1 op1 a2) op b1) op2 b2-> --todo: other cases-> _ -> def-> -- just left side-> (BinOp a1 op1 a2, _)-> -- a1 op1 a2 op b'-> | Just (_p,opa) <- lookupFixity op-> , Just (_p,op1a) <- lookupFixity op1-> -> case (opa, op1a) of-> (AssocRight, AssocRight) ->-> BinOp a1 op1 (BinOp a2 op b')-> (AssocLeft, AssocLeft) ->-> BinOp (BinOp a1 op1 a2) op b'-> _ -> def--> -- just right side-> (_, BinOp b1 op2 b2)-> -- e op b1 op2 b2-> | Just (_p,opa) <- lookupFixity op-> , Just (_p,op2a) <- lookupFixity op2-> -> case (opa, op2a) of-> (AssocRight, AssocRight) ->-> BinOp a' op (BinOp b1 op2 b2)-> (AssocLeft, AssocLeft) ->-> BinOp (BinOp a' op b1) op2 b2-> _ -> def-> _ -> def-> _ -> e--> fixBinOpPrecedence e = case e of-> BinOp a op b ->-> let a' = fixBinOpPrecedence a-> b' = fixBinOpPrecedence b-> def = BinOp a' op b'-> in case (a',b') of-> -- both-> -- a1 op1 a2 op b1 op2 b2-> -- all equal-> -- p > or < p1 == p2-> -- p == p1 < or > p2-> (BinOp a1 op1 a2-> ,BinOp b1 op2 b2)-> | Just (p,_opa) <- lookupFixity op-> , Just (p1,_op1a) <- lookupFixity op1-> , Just (p2,_op2a) <- lookupFixity op2-> -> case () of-> -- _ | trace ("both prec " ++ show (p,p1,p2)) False -> undefined-> _ | p == p1 && p1 == p2 -> def-> _ | p > p1 && p1 == p2 -> BinOp a1 op1 b'-> _ | p < p1 && p1 == p2 -> BinOp (BinOp a1 op1 a2) op b'-> _ | p == p1 && p2 > p1 -> BinOp a' op (BinOp b1 op2 b2)-> _ | p == p1 && p2 < p1 -> def -- todo-> _ | otherwise -> def-> -- just left side-> (BinOp a1 op1 a2, _)-> -- a1 op1 a2 op b'-> | Just (p,_opa) <- lookupFixity op-> , Just (p1,_op1a) <- lookupFixity op1-> -> case () of-> -- _ | trace ("left prec " ++ show (p,p1)) False -> undefined-> _ | p < p1 -> {-trace "b1" $ -}BinOp (BinOp a1 op1 a2) op b'-> | p > p1 -> {-trace "b2" $ -}BinOp a1 op1 (BinOp a2 op b')-> | otherwise -> def--> -- just right side-> (_, BinOp b1 op2 b2)-> -- a' op b1 op2 b2-> | Just (p,_opa) <- lookupFixity op-> , Just (p2,_op1a) <- lookupFixity op2-> -> case () of-> -- _ | trace ("right prec " ++ show (p,p2)) False -> undefined-> _ | p > p2 -> {-trace "b1" $ -}BinOp (BinOp a' op b1) op2 b2-> | p < p2 -> {-trace "b2" $ -}BinOp a' op (BinOp b1 op2 b2)-> | otherwise -> {-trace "def" $ -} def-> _ -> def-> _ -> e--> fixNestedPrefPostPrec e = case e of-> PrefOp op a ->-> let a' = fixNestedPrefPostPrec a-> in case a' of-> PostOp op1 b | Just (p,_) <- lookupFixity op-> , Just (p1,_) <- lookupFixity op1-> , p > p1 -> PostOp op1 (PrefOp op b)-> _ -> PrefOp op a'-> PostOp op a ->-> let a' = fixNestedPrefPostPrec a-> in case a' of-> PrefOp op1 b | Just (p,_) <- lookupFixity op-> , Just (p1,_) <- lookupFixity op1-> , p > p1 -> PrefOp op1 (PostOp op b)-> _ -> PostOp op a'-> _ -> e----> lookupFixity :: String -> Maybe (Int,Assoc)-> lookupFixity s = maybe (trace ("didn't find " ++ s ++ "\n" ++ ppShow fixities) Nothing)-> Just $ lookup s fixities---> sqlFixity :: [(String, (Int, Assoc))]-> sqlFixity = [(".", (13, AssocLeft))-> ,("[]", (12, AssocNone))--unary + --todo: split the fixity table into prefix, binary and postfix--todo: don't have explicit precedence numbers in the table??--> ,("^", (10, AssocNone))]-> ++ m ["*", "/", "%"] (9, AssocLeft)-> ++ m ["+","-"] (8, AssocLeft)-> ++ m ["<", ">", "=", "<=", ">=", "<>"] (4, AssocNone)-> ++ [("is null", (3, AssocNone))-> ,("not", (2, AssocRight))-> ,("and", (1, AssocLeft))-> ,("or", (0, AssocLeft))]--> where-> m l a = map (,a) l-----------some simple parser tests--> data Test = Group String [Test]-> | ParserTest String Expr-> | FixityTest Fixities Expr Expr--> parserTests :: Test-> parserTests = Group "parserTests" $ map (uncurry ParserTest) $-> [("a", Iden "a")-> ,("'test'", Lit "test")-> ,("34", Lit "34")-> ,("f()", App "f" [])-> ,("f(3)", App "f" [Lit "3"])-> ,("(7)", Parens (Lit "7"))-> ,("a + 3", BinOp (Iden "a") "+" (Lit "3"))-> ,("1 + 2 + 3", BinOp (BinOp (Lit "1") "+" (Lit "2")) "+" (Lit "3"))--> ,("a or b", BinOp (Iden "a") "or" (Iden "b"))-> ,("-1", PrefOp "-" (Lit "1"))-> ,("not a", PrefOp "not" (Iden "a"))-> ,("not not a", PrefOp "not" (PrefOp "not" (Iden "a")))-> ,("a is null", PostOp "is null" (Iden "a"))-> ,("a is null is null", PostOp "is null" (PostOp "is null" (Iden "a")))-> ,("-a+3", BinOp (PrefOp "-" (Iden "a")) "+" (Lit "3"))-> ,("a is null and b is null", BinOp (PostOp "is null" (Iden "a"))-> "and"-> (PostOp "is null" (Iden "b")))-> ]--> makeParserTest :: String -> Expr -> T.TestTree-> makeParserTest s e = H.testCase s $ do-> let a = parseExpr s-> if (Right e == a)-> then putStrLn $ s ++ " OK"-> else putStrLn $ "bad parse " ++ s ++ " " ++ show a----------fixity checks--test cases:---> fixityTests :: Test-> fixityTests = Group "fixityTests" $-> map (\(f,s,e) -> FixityTest f s e) $-> [--2 bin ops wrong associativity left + null versions--> (sqlFixity-> ,i "a" `plus` (i "b" `plus` i "c")-> ,(i "a" `plus` i "b") `plus` i "c")-> ,(sqlFixity-> ,(i "a" `plus` i "b") `plus` i "c"-> ,(i "a" `plus` i "b") `plus` i "c")--2 bin ops wrong associativity right--> ,(timesRight-> ,i "a" `times` (i "b" `times` i "c")-> ,i "a" `times` (i "b" `times` i "c"))-> ,(timesRight-> ,(i "a" `times` i "b") `times` i "c"-> ,i "a" `times` (i "b" `times` i "c"))---2 bin ops wrong precedence left--> ,(sqlFixity-> ,i "a" `plus` (i "b" `times` i "c")-> ,i "a" `plus` (i "b" `times` i "c"))--> ,(sqlFixity-> ,(i "a" `plus` i "b") `times` i "c"-> ,i "a" `plus` (i "b" `times` i "c"))--2 bin ops wrong precedence right--> ,(sqlFixity-> ,(i "a" `times` i "b") `plus` i "c"-> ,(i "a" `times` i "b") `plus` i "c")--> ,(sqlFixity-> ,i "a" `times` (i "b" `plus` i "c")-> ,(i "a" `times` i "b") `plus` i "c")--a + b * c + d-a * b + c * d--check all variations--> ] ++-> (let t = (i "a" `plus` i "b")-> `times`-> (i "c" `plus` i "d")-> trs = generateTrees $ splitTree t-> in [(sqlFixity, x-> ,i "a" `plus` (i "b" `times` i "c")-> `plus` i "d")-> | x <- trs])-> ++-> (let t = (i "a" `times` i "b")-> `plus`-> (i "c" `times` i "d")-> trs = generateTrees $ splitTree t-> in [(sqlFixity, x-> ,(i "a" `times` i "b")-> `plus`-> (i "c" `times` i "d"))-> | x <- trs])---> ++ [--prefix then postfix wrong precedence--> ([("+", (9, AssocNone))-> ,("is null", (3, AssocNone))]-> ,PrefOp "+" (PostOp "is null" (i "a"))-> ,PostOp "is null" (PrefOp "+" (i "a")))--> ,([("+", (9, AssocNone))-> ,("is null", (3, AssocNone))]-> ,PostOp "is null" (PrefOp "+" (i "a"))-> ,PostOp "is null" (PrefOp "+" (i "a")))--> ,([("+", (3, AssocNone))-> ,("is null", (9, AssocNone))]-> ,PrefOp "+" (PostOp "is null" (i "a"))-> ,PrefOp "+" (PostOp "is null" (i "a")))--> ,([("+", (3, AssocNone))-> ,("is null", (9, AssocNone))]-> ,PostOp "is null" (PrefOp "+" (i "a"))-> ,PrefOp "+" (PostOp "is null" (i "a")))--3-way unary operator movement:-take a starting point and generate variations--postfix on first arg of binop (cannot move) make sure precedence wants- it to move--prefix on second arg of binop (cannot move)--prefix on binop, precedence wrong-postfix on binop precedence wrong-prefix on first arg of binop, precedence wrong-postfix on second arg of binop, precedence wrong--ambiguous fixity tests--sanity check: parens stops rearrangement--check nesting 1 + f(expr)--> ]-> where-> plus a b = BinOp a "+" b-> times a b = BinOp a "*" b-> i a = Iden a-> timesRight = [("*", (9, AssocRight))]--testCase--> makeFixityTest :: Fixities -> Expr -> Expr -> T.TestTree-> makeFixityTest fs s e = H.testCase (show s) $ do-> let s' = fixFixity fs s-> H.assertEqual "" s' e-> {-if (s' == e)-> then putStrLn $ show s ++ " OK"-> else putStrLn $ "ERROR\nstart: " ++ show s ++ "\nfixed: " ++ show s' ++ "\nshould be: " ++ show e-}--> tests :: Test-> tests = Group "Tests" [parserTests, fixityTests]--> makeTest :: Test -> T.TestTree-> makeTest (Group n ts) = T.testGroup n $ map makeTest ts-> makeTest (ParserTest s e) = makeParserTest s e-> makeTest (FixityTest f s e) = makeFixityTest f s e------------ > tests :: T.TestTree- > tests = T.testGroup "Tests" $ map makeFixityTest fixityTests--> main :: IO ()-> main = T.defaultMain $ makeTest tests-> {-do-> mapM_ checkTest tests-> mapM_ checkFixity fixityTests-> let plus a b = BinOp a "+" b-> times a b = BinOp a "*" b-> i a = Iden a-> let t = (i "a" `plus` i "b")-> `times`-> (i "c" `plus` i "d")-> spl = splitTree t-> trs = generateTrees spl-> --putStrLn $ "\nSplit\n"-> --putStrLn $ ppShow (fst spl, length $ snd spl)-> --putStrLn $ show $ length trs-> --putStrLn $ "\nTrees\n"-> --putStrLn $ intercalate "\n" $ map show trs-> return ()-}--generating trees--1. tree -> list-val op val op val op ...-(has to be two lists?--generate variations:-pick numbers from 0 to n - 1 (n is the number of ops)-choose the op at this position to be the root-recurse on the two sides--> splitTree :: Expr -> ([Expr], [Expr->Expr->Expr])-> splitTree (BinOp a op b) = let (x,y) = splitTree a-> (z,w) = splitTree b-> in (x++z, y++ [\a b -> BinOp a op b] ++ w)-> splitTree x = ([x],[])----> generateTrees :: ([Expr], [Expr->Expr->Expr]) -> [Expr]-> generateTrees (es,ops) | length es /= length ops + 1 =-> error $ "mismatch in lengths " ++ show (length es, length ops)-> ++"\n" ++ ppShow es ++ "\n"-> generateTrees ([a,b], [op]) = [op a b]-> generateTrees ([a], []) = [a]-> generateTrees (vs, ops) =-> let n = length ops-> in --trace ("generating " ++ show (length vs, n) ++ "trees\n") $-> concat $ flip map [0..n-1] $ \m ->-> let (v1,v2) = splitAt (m + 1) vs-> (ops1,op':ops2) = splitAt m ops-> r = [op' t u | t <- generateTrees (v1,ops1)-> , u <- generateTrees (v2,ops2)]-> in -- trace ("generated " ++ show (length r) ++ " trees")-> r-> generateTrees ([],[]) = []---
− tools/Language/SQL/SimpleSQL/CustomDialect.lhs
@@ -1,27 +0,0 @@--> module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where--> import Language.SQL.SimpleSQL.TestTypes--> customDialectTests :: TestItem-> customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests-> ++ map (uncurry ParseScalarExprFails) failTests )-> where-> failTests = [(ansi2011,"SELECT DATE('2000-01-01')")-> ,(ansi2011,"SELECT DATE")-> ,(dateApp,"SELECT DATE")-> ,(dateIden,"SELECT DATE('2000-01-01')")-> -- show this never being allowed as an alias-> ,(ansi2011,"SELECT a date")-> ,(dateApp,"SELECT a date")-> ,(dateIden,"SELECT a date")-> ]-> passTests = [(ansi2011,"SELECT a b")-> ,(noDateKeyword,"SELECT DATE('2000-01-01')")-> ,(noDateKeyword,"SELECT DATE")-> ,(dateApp,"SELECT DATE('2000-01-01')")-> ,(dateIden,"SELECT DATE")-> ]-> noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}-> dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}-> dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}
− tools/Language/SQL/SimpleSQL/ErrorMessages.lhs
@@ -1,150 +0,0 @@--Want to work on the error messages. Ultimately, parsec won't give the-best error message for a parser combinator library in haskell. Should-check out the alternatives such as polyparse and uu-parsing.--For now the plan is to try to get the best out of parsec. Skip heavy-work on this until the parser is more left factored?--Ideas:--1. generate large lists of invalid syntax-2. create table of the sql source and the error message-3. save these tables and compare from version to version. Want to- catch improvements and regressions and investigate. Have to do this- manually--= generating bad sql source--take good sql statements or expressions. Convert them into sequences-of tokens - want to preserve the whitespace and comments perfectly-here. Then modify these lists by either adding a token, removing a-token, or modifying a token (including creating bad tokens of raw-strings which don't represent anything than can be tokenized.--Now can see the error message for all of these bad strings. Probably-have to generate and prune this list manually in stages since there-will be too many.--Contexts:--another area to focus on is contexts: for instance, we have a set of-e.g. 1000 bad scalar expressions with error messages. Now can put-those bad scalar expressions into various contexts and see that the-error messages are still good.--plan:--1. create a list of all the value expression, with some variations for- each-2. manually create some error variations for each expression-3. create a renderer which will create a csv of the expressions and- the errors- this is to load as a spreadsheet to investigate more-4. create a renderer for the csv which will create a markdown file for- the website. this is to demonstrate the error messages in the- documentation--Then create some contexts for all of these: inside another value-expression, or inside a query expression. Do the same: render and-review the error messages.--Then, create some query expressions to focus on the non value-expression parts.---> module Language.SQL.SimpleSQL.ErrorMessages where--> {-import Language.SQL.SimpleSQL.Parser-> import Data.List-> import Text.Groom--> valueExpressions :: [String]-> valueExpressions =-> ["10.."-> ,"..10"-> ,"10e1e2"-> ,"10e--3"-> ,"1a"-> ,"1%"--> ,"'b'ad'"-> ,"'bad"-> ,"bad'"--> ,"interval '5' ay"-> ,"interval '5' day (4.4)"-> ,"interval '5' day (a)"-> ,"intervala '5' day"-> ,"interval 'x' day (3"-> ,"interval 'x' day 3)"--> ,"1badiden"-> ,"$"-> ,"!"-> ,"*.a"--> ,"??"-> ,"3?"-> ,"?a"--> ,"row"-> ,"row 1,2"-> ,"row(1,2"-> ,"row 1,2)"-> ,"row(1 2)"--> ,"f("-> ,"f)"--> ,"f(a"-> ,"f a)"-> ,"f(a b)"--TODO:-case-operators--> ,"a + (b + c"--casts-subqueries: + whole set of parentheses use-in list-'keyword' functions-aggregates-window functions---> ]--> queryExpressions :: [String]-> queryExpressions =-> map sl1 valueExpressions-> ++ map sl2 valueExpressions-> ++ map sl3 valueExpressions-> ++-> ["select a from t inner jin u"]-> where-> sl1 x = "select " ++ x ++ " from t"-> sl2 x = "select " ++ x ++ ", y from t"-> sl3 x = "select " ++ x ++ " fom t"--> valExprs :: [String] -> [(String,String)]-> valExprs = map parseOne-> where-> parseOne x = let p = parseValueExpr "" Nothing x-> in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)---> queryExprs :: [String] -> [(String,String)]-> queryExprs = map parseOne-> where-> parseOne x = let p = parseQueryExpr "" Nothing x-> in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)---> pExprs :: [String] -> [String] -> String-> pExprs x y =-> let l = valExprs x ++ queryExprs y-> in intercalate "\n\n\n\n" $ map (\(a,b) -> a ++ "\n" ++ b) l-> -}
− tools/Language/SQL/SimpleSQL/FullQueries.lhs
@@ -1,39 +0,0 @@--Some tests for parsing full queries.--> module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax---> fullQueriesTests :: TestItem-> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))-> [("select count(*) from t"-> ,makeSelect-> {qeSelectList = [(App [Name Nothing "count"] [Star], Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }-> )--> ,("select a, sum(c+d) as s\n\-> \ from t,u\n\-> \ where a > 5\n\-> \ group by a\n\-> \ having count(1) > 5\n\-> \ order by s"-> ,makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)-> ,(App [Name Nothing "sum"]-> [BinOp (Iden [Name Nothing "c"])-> [Name Nothing "+"] (Iden [Name Nothing "d"])]-> ,Just $ Name Nothing "s")]-> ,qeFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]-> ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")-> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]-> ,qeHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"])-> [Name Nothing ">"] (NumLit "5")-> ,qeOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault]-> }-> )-> ]
− tools/Language/SQL/SimpleSQL/GroupBy.lhs
@@ -1,235 +0,0 @@--Here are the tests for the group by component of query exprs--> module Language.SQL.SimpleSQL.GroupBy (groupByTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax---> groupByTests :: TestItem-> groupByTests = Group "groupByTests"-> [simpleGroupBy-> ,newGroupBy-> ,randomGroupBy-> ]--> simpleGroupBy :: TestItem-> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a,sum(b) from t group by a"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)-> ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]-> })--> ,("select a,b,sum(c) from t group by a,b"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)-> ,(Iden [Name Nothing "b"],Nothing)-> ,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]-> ,SimpleGroup $ Iden [Name Nothing "b"]]-> })-> ]--test the new group by (), grouping sets, cube and rollup syntax (not-sure which sql version they were introduced, 1999 or 2003 I think).--> newGroupBy :: TestItem-> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))-> [("select * from t group by ()", ms [GroupingParens []])-> ,("select * from t group by grouping sets ((), (a))"-> ,ms [GroupingSets [GroupingParens []-> ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]])-> ,("select * from t group by cube(a,b)"-> ,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])-> ,("select * from t group by rollup(a,b)"-> ,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])-> ]-> where-> ms g = makeSelect {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeGroupBy = g}--> randomGroupBy :: TestItem-> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)-> ["select * from t GROUP BY a"-> ,"select * from t GROUP BY GROUPING SETS((a))"-> ,"select * from t GROUP BY a,b,c"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c))"-> ,"select * from t GROUP BY ROLLUP(a,b)"-> ,"select * from t GROUP BY GROUPING SETS((a,b),\n\-> \(a),\n\-> \() )"-> ,"select * from t GROUP BY ROLLUP(b,a)"-> ,"select * from t GROUP BY GROUPING SETS((b,a),\n\-> \(b),\n\-> \() )"-> ,"select * from t GROUP BY CUBE(a,b,c)"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\-> \(a,b),\n\-> \(a,c),\n\-> \(b,c),\n\-> \(a),\n\-> \(b),\n\-> \(c),\n\-> \() )"-> ,"select * from t GROUP BY ROLLUP(Province, County, City)"-> ,"select * from t GROUP BY ROLLUP(Province, (County, City))"-> ,"select * from t GROUP BY ROLLUP(Province, (County, City))"-> ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\-> \(Province),\n\-> \() )"-> ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\-> \(Province, County),\n\-> \(Province),\n\-> \() )"-> ,"select * from t GROUP BY a, ROLLUP(b,c)"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\-> \(a,b),\n\-> \(a) )"-> ,"select * from t GROUP BY a, b, ROLLUP(c,d)"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\-> \(a,b,c),\n\-> \(a,b) )"-> ,"select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\-> \(a,b),\n\-> \(a),\n\-> \(b,c),\n\-> \(b),\n\-> \() )"-> ,"select * from t GROUP BY ROLLUP(a), CUBE(b,c)"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\-> \(a,b),\n\-> \(a,c),\n\-> \(a),\n\-> \(b,c),\n\-> \(b),\n\-> \(c),\n\-> \() )"-> ,"select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"-> ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\-> \(a,b,c),\n\-> \(a,b),\n\-> \(a,c,d),\n\-> \(a,c),\n\-> \(a),\n\-> \(b,c,d),\n\-> \(b,c),\n\-> \(b),\n\-> \(c,d),\n\-> \(c),\n\-> \() )"-> ,"select * from t GROUP BY a, ROLLUP(a,b)"-> ,"select * from t GROUP BY GROUPING SETS((a,b),\n\-> \(a) )"-> ,"select * from t GROUP BY Region,\n\-> \ROLLUP(Sales_Person, WEEK(Sales_Date)),\n\-> \CUBE(YEAR(Sales_Date), MONTH (Sales_Date))"-> ,"select * from t GROUP BY ROLLUP (Region, Sales_Person, WEEK(Sales_Date),\n\-> \YEAR(Sales_Date), MONTH(Sales_Date) )"--> ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \WHERE WEEK(SALES_DATE) = 13\n\-> \GROUP BY WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON\n\-> \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"--> ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \WHERE WEEK(SALES_DATE) = 13\n\-> \GROUP BY GROUPING SETS ( (WEEK(SALES_DATE), SALES_PERSON),\n\-> \(DAYOFWEEK(SALES_DATE), SALES_PERSON))\n\-> \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"--> ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \WHERE WEEK(SALES_DATE) = 13\n\-> \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\-> \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"--> ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \WHERE WEEK(SALES_DATE) = 13\n\-> \GROUP BY CUBE ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\-> \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"--> ,"SELECT SALES_PERSON,\n\-> \MONTH(SALES_DATE) AS MONTH,\n\-> \SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \GROUP BY GROUPING SETS ( (SALES_PERSON, MONTH(SALES_DATE)),\n\-> \()\n\-> \)\n\-> \ORDER BY SALES_PERSON, MONTH"--> ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) )\n\-> \ORDER BY WEEK, DAY_WEEK"--> ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\-> \REGION,\n\-> \SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \GROUP BY ROLLUP ( MONTH(SALES_DATE), REGION )\n\-> \ORDER BY MONTH, REGION"--> ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \MONTH(SALES_DATE) AS MONTH,\n\-> \REGION,\n\-> \SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES\n\-> \GROUP BY GROUPING SETS ( ROLLUP( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) ),\n\-> \ROLLUP( MONTH(SALES_DATE), REGION ) )\n\-> \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"--> ,"SELECT R1, R2,\n\-> \WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \MONTH(SALES_DATE) AS MONTH,\n\-> \REGION, SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\-> \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\-> \DAYOFWEEK(SALES_DATE))),\n\-> \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\-> \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"--> {-,"SELECT COALESCE(R1,R2) AS GROUP,\n\-> \WEEK(SALES_DATE) AS WEEK,\n\-> \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\-> \MONTH(SALES_DATE) AS MONTH,\n\-> \REGION, SUM(SALES) AS UNITS_SOLD\n\-> \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\-> \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\-> \DAYOFWEEK(SALES_DATE))),\n\-> \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\-> \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-}-> -- as group - needs more subtle keyword blacklisting--> -- decimal as a function not allowed due to the reserved keyword-> -- handling: todo, review if this is ansi standard function or-> -- if there are places where reserved keywords can still be used-> ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\-> \REGION,\n\-> \SUM(SALES) AS UNITS_SOLD,\n\-> \MAX(SALES) AS BEST_SALE,\n\-> \CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\-> \FROM SALES\n\-> \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\-> \ORDER BY MONTH, REGION"--> ]
− tools/Language/SQL/SimpleSQL/LexerTests.lhs
@@ -1,335 +0,0 @@---Test for the lexer--> module Language.SQL.SimpleSQL.LexerTests (lexerTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Lex (Token(..),tokenListWillPrintAndLex)-> --import Debug.Trace-> --import Data.Char (isAlpha)-> import Data.List--> lexerTests :: TestItem-> lexerTests = Group "lexerTests" $-> [Group "lexer token tests" [ansiLexerTests-> ,postgresLexerTests-> ,sqlServerLexerTests-> ,oracleLexerTests-> ,mySqlLexerTests-> ,odbcLexerTests]]--> ansiLexerTable :: [(String,[Token])]-> ansiLexerTable =-> -- single char symbols-> map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()"-> -- multi char symbols-> ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"]-> ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]-> -- simple identifiers-> in map (\i -> (i, [Identifier Nothing i])) idens-> ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens-> -- todo: in order to make lex . pretty id, need to-> -- preserve the case of the u-> ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens-> -- host param-> ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens-> )-> -- quoted identifiers with embedded double quotes-> -- the lexer doesn't unescape the quotes-> ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]-> -- strings-> -- the lexer doesn't apply escapes at all-> ++ [("'string'", [SqlString "'" "'" "string"])-> ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])-> ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])-> ,("'\n'", [SqlString "'" "'" "\n"])]-> -- csstrings-> ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))-> ["n", "N","b", "B","x", "X", "u&"]-> -- numbers-> ++ [("10", [SqlNumber "10"])-> ,(".1", [SqlNumber ".1"])-> ,("5e3", [SqlNumber "5e3"])-> ,("5e+3", [SqlNumber "5e+3"])-> ,("5e-3", [SqlNumber "5e-3"])-> ,("10.2", [SqlNumber "10.2"])-> ,("10.2e7", [SqlNumber "10.2e7"])]-> -- whitespace-> ++ concat [[([a],[Whitespace [a]])-> ,([a,b], [Whitespace [a,b]])]-> | a <- " \n\t", b <- " \n\t"]-> -- line comment-> ++ map (\c -> (c, [LineComment c]))-> ["--", "-- ", "-- this is a comment", "-- line com\n"]-> -- block comment-> ++ map (\c -> (c, [BlockComment c]))-> ["/**/", "/* */","/* this is a comment */"-> ,"/* this *is/ a comment */"-> ]--> ansiLexerTests :: TestItem-> ansiLexerTests = Group "ansiLexerTests" $-> [Group "ansi lexer token tests" $ [LexTest ansi2011 s t | (s,t) <- ansiLexerTable]-> ,Group "ansi generated combination lexer tests" $-> [ LexTest ansi2011 (s ++ s1) (t ++ t1)-> | (s,t) <- ansiLexerTable-> , (s1,t1) <- ansiLexerTable-> , tokenListWillPrintAndLex ansi2011 $ t ++ t1--> ]-> ,Group "ansiadhoclexertests" $-> map (uncurry $ LexTest ansi2011)-> [("", [])-> ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"])-> ] ++-> [-- want to make sure this gives a parse error-> LexFails ansi2011 "*/"-> -- combinations of pipes: make sure they fail because they could be-> -- ambiguous and it is really unclear when they are or not, and-> -- what the result is even when they are not ambiguous-> ,LexFails ansi2011 "|||"-> ,LexFails ansi2011 "||||"-> ,LexFails ansi2011 "|||||"-> -- another user experience thing: make sure extra trailing-> -- number chars are rejected rather than attempting to parse-> -- if the user means to write something that is rejected by this code,-> -- then they can use whitespace to make it clear and then it will parse-> ,LexFails ansi2011 "12e3e4"-> ,LexFails ansi2011 "12e3e4"-> ,LexFails ansi2011 "12e3e4"-> ,LexFails ansi2011 "12e3.4"-> ,LexFails ansi2011 "12.4.5"-> ,LexFails ansi2011 "12.4e5.6"-> ,LexFails ansi2011 "12.4e5e7"]-> ]--todo: lexing tests-do quickcheck testing:-can try to generate valid tokens then check they parse--same as above: can also try to pair tokens, create an accurate- function to say which ones can appear adjacent, and test--I think this plus the explicit lists of tokens like above which do-basic sanity + explicit edge casts will provide a high level of-assurance.----> postgresLexerTable :: [(String,[Token])]-> postgresLexerTable =-> -- single char symbols-> map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;():"-> -- multi char symbols-> ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]-> -- generic symbols--> ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]-> -- simple identifiers-> in map (\i -> (i, [Identifier Nothing i])) idens-> ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens-> -- todo: in order to make lex . pretty id, need to-> -- preserve the case of the u-> ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens-> -- host param-> ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens-> )-> -- positional var-> ++ [("$1", [PositionalArg 1])]-> -- quoted identifiers with embedded double quotes-> ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]-> -- strings-> ++ [("'string'", [SqlString "'" "'" "string"])-> ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])-> ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])-> ,("'\n'", [SqlString "'" "'" "\n"])-> ,("E'\n'", [SqlString "E'" "'" "\n"])-> ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])-> ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])-> ,("'not this \\' quote", [SqlString "'" "'" "not this \\"-> ,Whitespace " "-> ,Identifier Nothing "quote"])-> ,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])-> ,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])-> ,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])-> ]-> -- csstrings-> ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))-> ["n", "N","b", "B","x", "X", "u&", "e", "E"]-> -- numbers-> ++ [("10", [SqlNumber "10"])-> ,(".1", [SqlNumber ".1"])-> ,("5e3", [SqlNumber "5e3"])-> ,("5e+3", [SqlNumber "5e+3"])-> ,("5e-3", [SqlNumber "5e-3"])-> ,("10.2", [SqlNumber "10.2"])-> ,("10.2e7", [SqlNumber "10.2e7"])]-> -- whitespace-> ++ concat [[([a],[Whitespace [a]])-> ,([a,b], [Whitespace [a,b]])]-> | a <- " \n\t", b <- " \n\t"]-> -- line comment-> ++ map (\c -> (c, [LineComment c]))-> ["--", "-- ", "-- this is a comment", "-- line com\n"]-> -- block comment-> ++ map (\c -> (c, [BlockComment c]))-> ["/**/", "/* */","/* this is a comment */"-> ,"/* this *is/ a comment */"-> ]--An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:--+ - * / < > = ~ ! @ # % ^ & | ` ?--There are a few restrictions on operator names, however:--- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.--A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:--~ ! @ # % ^ & | ` ?--todo: 'negative' tests-symbol then ---symbol then /*-operators without one of the exception chars- followed by + or - without whitespace--also: do the testing for the ansi compatibility special cases--> postgresShortOperatorTable :: [(String,[Token])]-> postgresShortOperatorTable =-> [ (x, [Symbol x]) | x <- someValidPostgresOperators 2]---> postgresExtraOperatorTable :: [(String,[Token])]-> postgresExtraOperatorTable =-> [ (x, [Symbol x]) | x <- someValidPostgresOperators 4]---> someValidPostgresOperators :: Int -> [String]-> someValidPostgresOperators l =-> [ x-> | n <- [1..l]-> , x <- combos "+-*/<>=~!@#%^&|`?" n-> , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)-> , not (last x `elem` "+-")-> || or (map (`elem` x) "~!@#%^&|`?")-> ]--These are postgres operators, which if followed immediately by a + or--, will lex as separate operators rather than one operator including-the + or -.--> somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [String]-> somePostgresOpsWhichWontAddTrailingPlusMinus l =-> [ x-> | n <- [1..l]-> , x <- combos "+-*/<>=" n-> , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)-> , not (last x `elem` "+-")-> ]---> postgresLexerTests :: TestItem-> postgresLexerTests = Group "postgresLexerTests" $-> [Group "postgres lexer token tests" $-> [LexTest postgres s t | (s,t) <- postgresLexerTable]-> ,Group "postgres generated lexer token tests" $-> [LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]-> ,Group "postgres generated combination lexer tests" $-> [ LexTest postgres (s ++ s1) (t ++ t1)-> | (s,t) <- postgresLexerTable ++ postgresShortOperatorTable-> , (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable-> , tokenListWillPrintAndLex postgres $ t ++ t1--> ]-> ,Group "generated postgres edgecase lexertests" $-> [LexTest postgres s t-> | (s,t) <- edgeCaseCommentOps-> ++ edgeCasePlusMinusOps-> ++ edgeCasePlusMinusComments]--> ,Group "adhoc postgres lexertests" $-> -- need more tests for */ to make sure it is caught if it is in the middle of a-> -- sequence of symbol letters-> [LexFails postgres "*/"-> ,LexFails postgres ":::"-> ,LexFails postgres "::::"-> ,LexFails postgres ":::::"-> ,LexFails postgres "@*/"-> ,LexFails postgres "-*/"-> ,LexFails postgres "12e3e4"-> ,LexFails postgres "12e3e4"-> ,LexFails postgres "12e3e4"-> ,LexFails postgres "12e3.4"-> ,LexFails postgres "12.4.5"-> ,LexFails postgres "12.4e5.6"-> ,LexFails postgres "12.4e5e7"-> -- special case allow this to lex to 1 .. 2-> -- this is for 'for loops' in plpgsql-> ,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]-> ]-> where-> edgeCaseCommentOps =-> [ (x ++ "/*<test*/", [Symbol x, BlockComment "/*<test*/"])-> | x <- eccops-> , not (last x == '*')-> ] ++-> [ (x ++ "--<test", [Symbol x, LineComment "--<test"])-> | x <- eccops-> , not (last x == '-')-> ]-> eccops = someValidPostgresOperators 2-> edgeCasePlusMinusOps = concat-> [ [ (x ++ "+", [Symbol x, Symbol "+"])-> , (x ++ "-", [Symbol x, Symbol "-"]) ]-> | x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2-> ]-> edgeCasePlusMinusComments =-> [("---", [LineComment "---"])-> ,("+--", [Symbol "+", LineComment "--"])-> ,("-/**/", [Symbol "-", BlockComment "/**/"])-> ,("+/**/", [Symbol "+", BlockComment "/**/"])-> ]---> sqlServerLexerTests :: TestItem-> sqlServerLexerTests = Group "sqlServerLexTests" $-> [ LexTest sqlserver s t | (s,t) <--> [("@variable", [(PrefixedVariable '@' "variable")])-> ,("#variable", [(PrefixedVariable '#' "variable")])-> ,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])-> ]]--> oracleLexerTests :: TestItem-> oracleLexerTests = Group "oracleLexTests" $-> [] -- nothing oracle specific atm--> mySqlLexerTests :: TestItem-> mySqlLexerTests = Group "mySqlLexerTests" $-> [ LexTest mysql s t | (s,t) <--> [("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])-> ]-> ]--> odbcLexerTests :: TestItem-> odbcLexerTests = Group "odbcLexTests" $-> [ LexTest sqlserver {diOdbc = True} s t | (s,t) <--> [("{}", [Symbol "{", Symbol "}"])-> ]]-> ++ [LexFails sqlserver "{"-> ,LexFails sqlserver "}"]--> combos :: [a] -> Int -> [[a]]-> combos _ 0 = [[]]-> combos l n = [ x:tl | x <- l, tl <- combos l (n - 1) ]--figure out a way to do quickcheck testing:-1. generate valid tokens and check they parse--2. combine two generated tokens together for the combo testing--this especially will work much better for the postgresql extensible-operator tests which doing exhaustively takes ages and doesn't bring-much benefit over testing a few using quickcheck.
− tools/Language/SQL/SimpleSQL/MySQL.lhs
@@ -1,40 +0,0 @@--Tests for mysql dialect parsing--> module Language.SQL.SimpleSQL.MySQL (mySQLTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> mySQLTests :: TestItem-> mySQLTests = Group "mysql dialect"-> [backtickQuotes-> ,limit]--backtick quotes--limit syntax--[LIMIT {[offset,] row_count | row_count OFFSET offset}]--> backtickQuotes :: TestItem-> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))-> [("`test`", Iden [Name (Just ("`","`")) "test"])-> ]-> ++ [ParseScalarExprFails ansi2011 "`test`"]-> )--> limit :: TestItem-> limit = Group "queries" ( map (uncurry (TestQueryExpr mysql))-> [("select * from t limit 5"-> ,sel {qeFetchFirst = Just (NumLit "5")}-> )-> ]-> ++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"-> ,ParseQueryExprFails ansi2011 "select * from t limit 5"]-> )-> where-> sel = makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }
− tools/Language/SQL/SimpleSQL/Odbc.lhs
@@ -1,52 +0,0 @@--> module Language.SQL.SimpleSQL.Odbc (odbcTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> odbcTests :: TestItem-> odbcTests = Group "odbc" [-> Group "datetime" [-> e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")-> ,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")-> ,e "{ts '2000-01-01 12:00:01.1'}"-> (OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")-> ]-> ,Group "functions" [-> e "{fn CHARACTER_LENGTH(string_exp)}"-> $ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])-> ,e "{fn EXTRACT(day from t)}"-> $ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])-> ,e "{fn now()}"-> $ OdbcFunc (ap "now" [])-> ,e "{fn CONVERT('2000-01-01', SQL_DATE)}"-> $ OdbcFunc (ap "CONVERT"-> [StringLit "'" "'" "2000-01-01"-> ,iden "SQL_DATE"])-> ,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"-> $ OdbcFunc (ap "CONVERT"-> [OdbcFunc (ap "CURDATE" [])-> ,iden "SQL_DATE"])-> ]-> ,Group "outer join" [-> TestQueryExpr ansi2011 {diOdbc=True}-> "select * from {oj t1 left outer join t2 on expr}"-> $ makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"])-> (Just $ JoinOn $ Iden [Name Nothing "expr"])]}]-> ,Group "check parsing bugs" [-> TestQueryExpr ansi2011 {diOdbc=True}-> "select {fn CONVERT(cint,SQL_BIGINT)} from t;"-> $ makeSelect-> {qeSelectList = [(OdbcFunc (ap "CONVERT"-> [iden "cint"-> ,iden "SQL_BIGINT"]), Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}]-> ]-> where-> e = TestScalarExpr ansi2011 {diOdbc = True}-> --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}-> ap n = App [Name Nothing n]-> iden n = Iden [Name Nothing n]-
− tools/Language/SQL/SimpleSQL/Oracle.lhs
@@ -1,29 +0,0 @@--Tests for oracle dialect parsing--> module Language.SQL.SimpleSQL.Oracle (oracleTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> oracleTests :: TestItem-> oracleTests = Group "oracle dialect"-> [oracleLobUnits]---> oracleLobUnits :: TestItem-> oracleLobUnits = Group "oracleLobUnits" (map (uncurry (TestScalarExpr oracle))-> [("cast (a as varchar2(3 char))"-> ,Cast (Iden [Name Nothing "a"]) (-> PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters)))-> ,("cast (a as varchar2(3 byte))"-> ,Cast (Iden [Name Nothing "a"]) (-> PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecOctets)))-> ]-> ++ [TestStatement oracle-> "create table t (a varchar2(55 BYTE));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a")-> (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))-> Nothing []]]-> )
− tools/Language/SQL/SimpleSQL/Postgres.lhs
@@ -1,274 +0,0 @@--Here are some tests taken from the SQL in the postgres manual. Almost-all of the postgres specific syntax has been skipped, this can be-revisited when the dialect support is added.--> module Language.SQL.SimpleSQL.Postgres (postgresTests) where--> import Language.SQL.SimpleSQL.TestTypes--> postgresTests :: TestItem-> postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)--lexical syntax section--TODO: get all the commented out tests working--> [-- "SELECT 'foo'\n\-> -- \'bar';" -- this should parse as select 'foobar'-> -- ,-> "SELECT name, (SELECT max(pop) FROM cities\n\-> \ WHERE cities.state = states.name)\n\-> \ FROM states;"-> ,"SELECT ROW(1,2.5,'this is a test');"--> ,"SELECT ROW(t.*, 42) FROM t;"-> ,"SELECT ROW(t.f1, t.f2, 42) FROM t;"-> ,"SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));"--> ,"SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');"--> -- table is a reservered keyword?-> --,"SELECT ROW(table.*) IS NULL FROM table;"-> ,"SELECT ROW(tablex.*) IS NULL FROM tablex;"--> ,"SELECT true OR somefunc();"--> ,"SELECT somefunc() OR true;"--queries section--> ,"SELECT * FROM t1 CROSS JOIN t2;"-> ,"SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"-> ,"SELECT * FROM t1 INNER JOIN t2 USING (num);"-> ,"SELECT * FROM t1 NATURAL INNER JOIN t2;"-> ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"-> ,"SELECT * FROM t1 LEFT JOIN t2 USING (num);"-> ,"SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"-> ,"SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"-> ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"-> ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"--> ,"SELECT * FROM some_very_long_table_name s\n\-> \JOIN another_fairly_long_name a ON s.id = a.num;"-> ,"SELECT * FROM people AS mother JOIN people AS child\n\-> \ ON mother.id = child.mother_id;"-> ,"SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"-> ,"SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"-> ,"SELECT * FROM getfoo(1) AS t1;"-> ,"SELECT * FROM foo\n\-> \ WHERE foosubid IN (\n\-> \ SELECT foosubid\n\-> \ FROM getfoo(foo.fooid) z\n\-> \ WHERE z.fooid = foo.fooid\n\-> \ );"-> {-,"SELECT *\n\-> \ FROM dblink('dbname=mydb', 'SELECT proname, prosrc FROM pg_proc')\n\-> \ AS t1(proname name, prosrc text)\n\-> \ WHERE proname LIKE 'bytea%';"-} -- types in the alias??--> ,"SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"-> ,"SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"--> {-,"SELECT p1.id, p2.id, v1, v2\n\-> \FROM polygons p1, polygons p2,\n\-> \ LATERAL vertices(p1.poly) v1,\n\-> \ LATERAL vertices(p2.poly) v2\n\-> \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-} -- <-> operator?--> {-,"SELECT p1.id, p2.id, v1, v2\n\-> \FROM polygons p1 CROSS JOIN LATERAL vertices(p1.poly) v1,\n\-> \ polygons p2 CROSS JOIN LATERAL vertices(p2.poly) v2\n\-> \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-}--> ,"SELECT m.name\n\-> \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true\n\-> \WHERE pname IS NULL;"---> ,"SELECT * FROM fdt WHERE c1 > 5"--> ,"SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"--> ,"SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"--> ,"SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"--> ,"SELECT * FROM fdt WHERE c1 BETWEEN \n\-> \ (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100"--> ,"SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"--> ,"SELECT * FROM test1;"--> ,"SELECT x FROM test1 GROUP BY x;"-> ,"SELECT x, sum(y) FROM test1 GROUP BY x;"-> -- s.date changed to s.datex because of reserved keyword-> -- handling, not sure if this is correct or not for ansi sql-> ,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\-> \ FROM products p LEFT JOIN sales s USING (product_id)\n\-> \ GROUP BY product_id, p.name, p.price;"--> ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"-> ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"-> ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\-> \ FROM products p LEFT JOIN sales s USING (product_id)\n\-> \ WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\-> \ GROUP BY product_id, p.name, p.price, p.cost\n\-> \ HAVING sum(p.price * s.units) > 5000;"--> ,"SELECT a, b, c FROM t"--> ,"SELECT tbl1.a, tbl2.a, tbl1.b FROM t"--> ,"SELECT tbl1.*, tbl2.a FROM t"--> ,"SELECT a AS value, b + c AS sum FROM t"--> ,"SELECT a \"value\", b + c AS sum FROM t"--> ,"SELECT DISTINCT select_list t"--> ,"VALUES (1, 'one'), (2, 'two'), (3, 'three');"--> ,"SELECT 1 AS column1, 'one' AS column2\n\-> \UNION ALL\n\-> \SELECT 2, 'two'\n\-> \UNION ALL\n\-> \SELECT 3, 'three';"--> ,"SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"--> ,"WITH regional_sales AS (\n\-> \ SELECT region, SUM(amount) AS total_sales\n\-> \ FROM orders\n\-> \ GROUP BY region\n\-> \ ), top_regions AS (\n\-> \ SELECT region\n\-> \ FROM regional_sales\n\-> \ WHERE total_sales > (SELECT SUM(total_sales)/10 FROM regional_sales)\n\-> \ )\n\-> \SELECT region,\n\-> \ product,\n\-> \ SUM(quantity) AS product_units,\n\-> \ SUM(amount) AS product_sales\n\-> \FROM orders\n\-> \WHERE region IN (SELECT region FROM top_regions)\n\-> \GROUP BY region, product;"--> ,"WITH RECURSIVE t(n) AS (\n\-> \ VALUES (1)\n\-> \ UNION ALL\n\-> \ SELECT n+1 FROM t WHERE n < 100\n\-> \)\n\-> \SELECT sum(n) FROM t"--> ,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\-> \ SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'\n\-> \ UNION ALL\n\-> \ SELECT p.sub_part, p.part, p.quantity\n\-> \ FROM included_parts pr, parts p\n\-> \ WHERE p.part = pr.sub_part\n\-> \ )\n\-> \SELECT sub_part, SUM(quantity) as total_quantity\n\-> \FROM included_parts\n\-> \GROUP BY sub_part"--> ,"WITH RECURSIVE search_graph(id, link, data, depth) AS (\n\-> \ SELECT g.id, g.link, g.data, 1\n\-> \ FROM graph g\n\-> \ UNION ALL\n\-> \ SELECT g.id, g.link, g.data, sg.depth + 1\n\-> \ FROM graph g, search_graph sg\n\-> \ WHERE g.id = sg.link\n\-> \)\n\-> \SELECT * FROM search_graph;"--> {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\-> \ SELECT g.id, g.link, g.data, 1,\n\-> \ ARRAY[g.id],\n\-> \ false\n\-> \ FROM graph g\n\-> \ UNION ALL\n\-> \ SELECT g.id, g.link, g.data, sg.depth + 1,\n\-> \ path || g.id,\n\-> \ g.id = ANY(path)\n\-> \ FROM graph g, search_graph sg\n\-> \ WHERE g.id = sg.link AND NOT cycle\n\-> \)\n\-> \SELECT * FROM search_graph;"-} -- ARRAY--> {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\-> \ SELECT g.id, g.link, g.data, 1,\n\-> \ ARRAY[ROW(g.f1, g.f2)],\n\-> \ false\n\-> \ FROM graph g\n\-> \ UNION ALL\n\-> \ SELECT g.id, g.link, g.data, sg.depth + 1,\n\-> \ path || ROW(g.f1, g.f2),\n\-> \ ROW(g.f1, g.f2) = ANY(path)\n\-> \ FROM graph g, search_graph sg\n\-> \ WHERE g.id = sg.link AND NOT cycle\n\-> \)\n\-> \SELECT * FROM search_graph;"-} -- ARRAY--> ,"WITH RECURSIVE t(n) AS (\n\-> \ SELECT 1\n\-> \ UNION ALL\n\-> \ SELECT n+1 FROM t\n\-> \)\n\-> \SELECT n FROM t --LIMIT 100;" -- limit is not standard--select page reference--> ,"SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\-> \ FROM distributors d, films f\n\-> \ WHERE f.did = d.did"--> ,"SELECT kind, sum(len) AS total\n\-> \ FROM films\n\-> \ GROUP BY kind\n\-> \ HAVING sum(len) < interval '5 hours';"--> ,"SELECT * FROM distributors ORDER BY name;"-> ,"SELECT * FROM distributors ORDER BY 2;"--> ,"SELECT distributors.name\n\-> \ FROM distributors\n\-> \ WHERE distributors.name LIKE 'W%'\n\-> \UNION\n\-> \SELECT actors.name\n\-> \ FROM actors\n\-> \ WHERE actors.name LIKE 'W%';"--> ,"WITH t AS (\n\-> \ SELECT random() as x FROM generate_series(1, 3)\n\-> \ )\n\-> \SELECT * FROM t\n\-> \UNION ALL\n\-> \SELECT * FROM t"--> ,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\-> \ SELECT 1, employee_name, manager_name\n\-> \ FROM employee\n\-> \ WHERE manager_name = 'Mary'\n\-> \ UNION ALL\n\-> \ SELECT er.distance + 1, e.employee_name, e.manager_name\n\-> \ FROM employee_recursive er, employee e\n\-> \ WHERE er.employee_name = e.manager_name\n\-> \ )\n\-> \SELECT distance, employee_name FROM employee_recursive;"--> ,"SELECT m.name AS mname, pname\n\-> \FROM manufacturers m, LATERAL get_product_names(m.id) pname;"--> ,"SELECT m.name AS mname, pname\n\-> \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"--> ,"SELECT 2+2;"--> -- simple-sql-parser doesn't support where without from-> -- this can be added for the postgres dialect when it is written-> --,"SELECT distributors.* WHERE distributors.name = 'Westward';"--> ]
− tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -1,209 +0,0 @@--These are the tests for the query expression components apart from the-table refs which are in a separate file.---These are a few misc tests which don't fit anywhere else.--> module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax---> queryExprComponentTests :: TestItem-> queryExprComponentTests = Group "queryExprComponentTests"-> [duplicates-> ,selectLists-> ,whereClause-> ,having-> ,orderBy-> ,offsetFetch-> ,combos-> ,withQueries-> ,values-> ,tables-> ]----> duplicates :: TestItem-> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a from t" ,ms SQDefault)-> ,("select all a from t" ,ms All)-> ,("select distinct a from t", ms Distinct)-> ]-> where-> ms d = makeSelect-> {qeSetQuantifier = d-> ,qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}--> selectLists :: TestItem-> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))-> [("select 1",-> makeSelect {qeSelectList = [(NumLit "1",Nothing)]})--> ,("select a"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]})--> ,("select a,b"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)-> ,(Iden [Name Nothing "b"],Nothing)]})--> ,("select 1+2,3+4"-> ,makeSelect {qeSelectList =-> [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)-> ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]})--> ,("select a as a, /*comment*/ b as b"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")-> ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})--> ,("select a a, b b"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")-> ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})--> ,("select a + b * c"-> ,makeSelect {qeSelectList =-> [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]-> (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))-> ,Nothing)]})--> ]--> whereClause :: TestItem-> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a from t where a = 5"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})-> ]--> having :: TestItem-> having = Group "having" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a,sum(b) from t group by a having sum(b) > 5"-> ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)-> ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]-> ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]])-> [Name Nothing ">"] (NumLit "5")-> })-> ]--> orderBy :: TestItem-> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a from t order by a"-> ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault])--> ,("select a from t order by a, b"-> ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault])--> ,("select a from t order by a asc"-> ,ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault])--> ,("select a from t order by a desc, b desc"-> ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault])--> ,("select a from t order by a desc nulls first, b desc nulls last"-> ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst-> ,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast])--> ]-> where-> ms o = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeOrderBy = o}--> offsetFetch :: TestItem-> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))-> [-- ansi standard-> ("select a from t offset 5 rows fetch next 10 rows only"-> ,ms (Just $ NumLit "5") (Just $ NumLit "10"))-> ,("select a from t offset 5 rows;"-> ,ms (Just $ NumLit "5") Nothing)-> ,("select a from t fetch next 10 row only;"-> ,ms Nothing (Just $ NumLit "10"))-> ,("select a from t offset 5 row fetch first 10 row only"-> ,ms (Just $ NumLit "5") (Just $ NumLit "10"))-> -- postgres: disabled, will add back when postgres-> -- dialect is added-> --,("select a from t limit 10 offset 5"-> -- ,ms (Just $ NumLit "5") (Just $ NumLit "10"))-> ]-> where-> ms o l = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeOffset = o-> ,qeFetchFirst = l}--> combos :: TestItem-> combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a from t union select b from u"-> ,QueryExprSetOp ms1 Union SQDefault Respectively ms2)--> ,("select a from t intersect select b from u"-> ,QueryExprSetOp ms1 Intersect SQDefault Respectively ms2)--> ,("select a from t except all select b from u"-> ,QueryExprSetOp ms1 Except All Respectively ms2)--> ,("select a from t union distinct corresponding \-> \select b from u"-> ,QueryExprSetOp ms1 Union Distinct Corresponding ms2)--> ,("select a from t union select a from t union select a from t"-> -- TODO: union should be left associative. I think the others also-> -- so this needs to be fixed (new optionSuffix variation which-> -- handles this)-> ,QueryExprSetOp ms1 Union SQDefault Respectively-> (QueryExprSetOp ms1 Union SQDefault Respectively ms1))-> ]-> where-> ms1 = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}-> ms2 = makeSelect-> {qeSelectList = [(Iden [Name Nothing "b"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "u"]]}---> withQueries :: TestItem-> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))-> [("with u as (select a from t) select a from u"-> ,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2)--> ,("with u(b) as (select a from t) select a from u"-> ,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2)--> ,("with x as (select a from t),\n\-> \ u as (select a from x)\n\-> \select a from u"-> ,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2)--> ,("with recursive u as (select a from t) select a from u"-> ,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2)-> ]-> where-> ms c t = makeSelect-> {qeSelectList = [(Iden [Name Nothing c],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing t]]}-> ms1 = ms "a" "t"-> ms2 = ms "a" "u"-> ms3 = ms "a" "x"--> values :: TestItem-> values = Group "values" $ map (uncurry (TestQueryExpr ansi2011))-> [("values (1,2),(3,4)"-> ,Values [[NumLit "1", NumLit "2"]-> ,[NumLit "3", NumLit "4"]])-> ]--> tables :: TestItem-> tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))-> [("table tbl", Table [Name Nothing "tbl"])-> ]
− tools/Language/SQL/SimpleSQL/QueryExprs.lhs
@@ -1,24 +0,0 @@--These are the tests for the queryExprs parsing which parses multiple-query expressions from one string.--> module Language.SQL.SimpleSQL.QueryExprs (queryExprsTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> queryExprsTests :: TestItem-> queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011))-> [("select 1",[ms])-> ,("select 1;",[ms])-> ,("select 1;select 1",[ms,ms])-> ,(" select 1;select 1; ",[ms,ms])-> ,("SELECT CURRENT_TIMESTAMP;"-> ,[SelectStatement $ makeSelect-> {qeSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}])-> ,("SELECT \"CURRENT_TIMESTAMP\";"-> ,[SelectStatement $ makeSelect-> {qeSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}])-> ]-> where-> ms = SelectStatement $ makeSelect {qeSelectList = [(NumLit "1",Nothing)]}
− tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs
@@ -1,315 +0,0 @@--Section 12 in Foundation--grant, etc---> module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> sql2011AccessControlTests :: TestItem-> sql2011AccessControlTests = Group "sql 2011 access control tests" [--12 Access control--12.1 <grant statement>--<grant statement> ::=- <grant privilege statement>- | <grant role statement>--12.2 <grant privilege statement>--<grant privilege statement> ::=- GRANT <privileges> TO <grantee> [ { <comma> <grantee> }... ]- [ WITH HIERARCHY OPTION ]- [ WITH GRANT OPTION ]- [ GRANTED BY <grantor> ]--12.3 <privileges>-<privileges> ::=- <object privileges> ON <object name>--<object name> ::=- [ TABLE ] <table name>- | DOMAIN <domain name>- | COLLATION <collation name>- | CHARACTER SET <character set name>- | TRANSLATION <transliteration name>- | TYPE <schema-resolved user-defined type name>- | SEQUENCE <sequence generator name>- | <specific routine designator>--<object privileges> ::=- ALL PRIVILEGES- | <action> [ { <comma> <action> }... ]--<action> ::=- SELECT- | SELECT <left paren> <privilege column list> <right paren>- | SELECT <left paren> <privilege method list> <right paren>- | DELETE- | INSERT [ <left paren> <privilege column list> <right paren> ]- | UPDATE [ <left paren> <privilege column list> <right paren> ]- | REFERENCES [ <left paren> <privilege column list> <right paren> ]- | USAGE- | TRIGGER- | UNDER- | EXECUTE--<privilege method list> ::=- <specific routine designator> [ { <comma> <specific routine designator> }... ]--<privilege column list> ::=- <column name list>--<grantee> ::=- PUBLIC- | <authorization identifier>--<grantor> ::=- CURRENT_USER- | CURRENT_ROLE--> (TestStatement ansi2011-> "grant all privileges on tbl1 to role1"-> $ GrantPrivilege [PrivAll]-> (PrivTable [Name Nothing "tbl1"])-> [Name Nothing "role1"] WithoutGrantOption)---> ,(TestStatement ansi2011-> "grant all privileges on tbl1 to role1,role2"-> $ GrantPrivilege [PrivAll]-> (PrivTable [Name Nothing "tbl1"])-> [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant all privileges on tbl1 to role1 with grant option"-> $ GrantPrivilege [PrivAll]-> (PrivTable [Name Nothing "tbl1"])-> [Name Nothing "role1"] WithGrantOption)--> ,(TestStatement ansi2011-> "grant all privileges on table tbl1 to role1"-> $ GrantPrivilege [PrivAll]-> (PrivTable [Name Nothing "tbl1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant all privileges on domain mydom to role1"-> $ GrantPrivilege [PrivAll]-> (PrivDomain [Name Nothing "mydom"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant all privileges on type t1 to role1"-> $ GrantPrivilege [PrivAll]-> (PrivType [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant all privileges on sequence s1 to role1"-> $ GrantPrivilege [PrivAll]-> (PrivSequence [Name Nothing "s1"])-> [Name Nothing "role1"] WithoutGrantOption)---> ,(TestStatement ansi2011-> "grant select on table t1 to role1"-> $ GrantPrivilege [PrivSelect []]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant select(a,b) on table t1 to role1"-> $ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant delete on table t1 to role1"-> $ GrantPrivilege [PrivDelete]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant insert on table t1 to role1"-> $ GrantPrivilege [PrivInsert []]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant insert(a,b) on table t1 to role1"-> $ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant update on table t1 to role1"-> $ GrantPrivilege [PrivUpdate []]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant update(a,b) on table t1 to role1"-> $ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant references on table t1 to role1"-> $ GrantPrivilege [PrivReferences []]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant references(a,b) on table t1 to role1"-> $ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant usage on table t1 to role1"-> $ GrantPrivilege [PrivUsage]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant trigger on table t1 to role1"-> $ GrantPrivilege [PrivTrigger]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)---> ,(TestStatement ansi2011-> "grant execute on specific function f to role1"-> $ GrantPrivilege [PrivExecute]-> (PrivFunction [Name Nothing "f"])-> [Name Nothing "role1"] WithoutGrantOption)--> ,(TestStatement ansi2011-> "grant select,delete on table t1 to role1"-> $ GrantPrivilege [PrivSelect [], PrivDelete]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] WithoutGrantOption)--skipping for now:--what is 'under' action?--collation, character set, translation, member thing, methods--for review--some pretty big things missing in the standard:--schema, database--functions, etc., by argument types since they can be overloaded----12.4 <role definition>--<role definition> ::=- CREATE ROLE <role name> [ WITH ADMIN <grantor> ]--> ,(TestStatement ansi2011-> "create role rolee"-> $ CreateRole (Name Nothing "rolee"))---12.5 <grant role statement>--<grant role statement> ::=- GRANT <role granted> [ { <comma> <role granted> }... ]- TO <grantee> [ { <comma> <grantee> }... ]- [ WITH ADMIN OPTION ]- [ GRANTED BY <grantor> ]--<role granted> ::=- <role name>--> ,(TestStatement ansi2011-> "grant role1 to public"-> $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)--> ,(TestStatement ansi2011-> "grant role1,role2 to role3,role4"-> $ GrantRole [Name Nothing "role1",Name Nothing "role2"]-> [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)--> ,(TestStatement ansi2011-> "grant role1 to role3 with admin option"-> $ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)---12.6 <drop role statement>--<drop role statement> ::=- DROP ROLE <role name>--> ,(TestStatement ansi2011-> "drop role rolee"-> $ DropRole (Name Nothing "rolee"))---12.7 <revoke statement>--<revoke statement> ::=- <revoke privilege statement>- | <revoke role statement>--<revoke privilege statement> ::=- REVOKE [ <revoke option extension> ] <privileges>- FROM <grantee> [ { <comma> <grantee> }... ]- [ GRANTED BY <grantor> ]- <drop behavior>--<revoke option extension> ::=- GRANT OPTION FOR- | HIERARCHY OPTION FOR---> ,(TestStatement ansi2011-> "revoke select on t1 from role1"-> $ RevokePrivilege NoGrantOptionFor [PrivSelect []]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "revoke grant option for select on t1 from role1,role2 cascade"-> $ RevokePrivilege GrantOptionFor [PrivSelect []]-> (PrivTable [Name Nothing "t1"])-> [Name Nothing "role1",Name Nothing "role2"] Cascade)---<revoke role statement> ::=- REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]- FROM <grantee> [ { <comma> <grantee> }... ]- [ GRANTED BY <grantor> ]- <drop behavior>--<role revoked> ::=- <role name>--> ,(TestStatement ansi2011-> "revoke role1 from role2"-> $ RevokeRole NoAdminOptionFor [Name Nothing "role1"]-> [Name Nothing "role2"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "revoke role1,role2 from role3,role4"-> $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]-> [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)---> ,(TestStatement ansi2011-> "revoke admin option for role1 from role2 cascade"-> $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade)---> ]
− tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs
@@ -1,219 +0,0 @@--Sections 17 and 19 in Foundation--This module covers the tests for transaction management (begin,-commit, savepoint, etc.), and session management (set).---> module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> sql2011BitsTests :: TestItem-> sql2011BitsTests = Group "sql 2011 bits tests" [--17 Transaction management--17.1 <start transaction statement>--<start transaction statement> ::=- START TRANSACTION [ <transaction characteristics> ]--BEGIN is not in the standard!--> (TestStatement ansi2011-> "start transaction"-> $ StartTransaction)--17.2 <set transaction statement>--<set transaction statement> ::=- SET [ LOCAL ] TRANSACTION <transaction characteristics>--17.3 <transaction characteristics>--<transaction characteristics> ::=- [ <transaction mode> [ { <comma> <transaction mode> }... ] ]--<transaction mode> ::=- <isolation level>- | <transaction access mode>- | <diagnostics size>--<transaction access mode> ::=- READ ONLY- | READ WRITE--<isolation level> ::=- ISOLATION LEVEL <level of isolation>--<level of isolation> ::=- READ UNCOMMITTED- | READ COMMITTED- | REPEATABLE READ- | SERIALIZABLE--<diagnostics size> ::=- DIAGNOSTICS SIZE <number of conditions>--<number of conditions> ::=- <simple value specification>--17.4 <set constraints mode statement>--<set constraints mode statement> ::=- SET CONSTRAINTS <constraint name list> { DEFERRED | IMMEDIATE }--<constraint name list> ::=- ALL- | <constraint name> [ { <comma> <constraint name> }... ]--17.5 <savepoint statement>--<savepoint statement> ::=- SAVEPOINT <savepoint specifier>--<savepoint specifier> ::=- <savepoint name>--> ,(TestStatement ansi2011-> "savepoint difficult_bit"-> $ Savepoint $ Name Nothing "difficult_bit")---17.6 <release savepoint statement>--<release savepoint statement> ::=- RELEASE SAVEPOINT <savepoint specifier>--> ,(TestStatement ansi2011-> "release savepoint difficult_bit"-> $ ReleaseSavepoint $ Name Nothing "difficult_bit")---17.7 <commit statement>--<commit statement> ::=- COMMIT [ WORK ] [ AND [ NO ] CHAIN ]--> ,(TestStatement ansi2011-> "commit"-> $ Commit)--> ,(TestStatement ansi2011-> "commit work"-> $ Commit)---17.8 <rollback statement>--<rollback statement> ::=- ROLLBACK [ WORK ] [ AND [ NO ] CHAIN ] [ <savepoint clause> ]--<savepoint clause> ::=- TO SAVEPOINT <savepoint specifier>--> ,(TestStatement ansi2011-> "rollback"-> $ Rollback Nothing)--> ,(TestStatement ansi2011-> "rollback work"-> $ Rollback Nothing)--> ,(TestStatement ansi2011-> "rollback to savepoint difficult_bit"-> $ Rollback $ Just $ Name Nothing "difficult_bit")---19 Session management--19.1 <set session characteristics statement>--<set session characteristics statement> ::=- SET SESSION CHARACTERISTICS AS <session characteristic list>--<session characteristic list> ::=- <session characteristic> [ { <comma> <session characteristic> }... ]--<session characteristic> ::=- <session transaction characteristics>--<session transaction characteristics> ::=- TRANSACTION <transaction mode> [ { <comma> <transaction mode> }... ]--19.2 <set session user identifier statement>--<set session user identifier statement> ::=- SET SESSION AUTHORIZATION <value specification>--19.3 <set role statement>--<set role statement> ::=- SET ROLE <role specification>--<role specification> ::=- <value specification>- | NONE--19.4 <set local time zone statement>--<set local time zone statement> ::=- SET TIME ZONE <set time zone value>--<set time zone value> ::=- <interval value expression>- | LOCAL--19.5 <set catalog statement>--<set catalog statement> ::=- SET <catalog name characteristic>--<catalog name characteristic> ::=- CATALOG <value specification>--19.6 <set schema statement>--<set schema statement> ::=- SET <schema name characteristic>--<schema name characteristic> ::=- SCHEMA <value specification>--19.7 <set names statement>--<set names statement> ::=- SET <character set name characteristic>--<character set name characteristic> ::=- NAMES <value specification>--19.8 <set path statement>--<set path statement> ::=- SET <SQL-path characteristic>--<SQL-path characteristic> ::=- PATH <value specification>--19.9 <set transform group statement>--<set transform group statement> ::=- SET <transform group characteristic>--<transform group characteristic> ::=- DEFAULT TRANSFORM GROUP <value specification>- | TRANSFORM GROUP FOR TYPE <path-resolved user-defined type name> <value specification>--19.10 <set session collation statement>--<set session collation statement> ::=- SET COLLATION <collation specification> [ FOR <character set specification list> ]- | SET NO COLLATION [ FOR <character set specification list> ]--<collation specification> ::=- <value specification>--> ]
− tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs
@@ -1,544 +0,0 @@--Section 14 in Foundation---> module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> sql2011DataManipulationTests :: TestItem-> sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"-> [---14 Data manipulation---14.1 <declare cursor>--<declare cursor> ::=- DECLARE <cursor name> <cursor properties>- FOR <cursor specification>--14.2 <cursor properties>--<cursor properties> ::=- [ <cursor sensitivity> ] [ <cursor scrollability> ] CURSOR- [ <cursor holdability> ]- [ <cursor returnability> ]--<cursor sensitivity> ::=- SENSITIVE- | INSENSITIVE- | ASENSITIVE--<cursor scrollability> ::=- SCROLL- | NO SCROLL--<cursor holdability> ::=- WITH HOLD- | WITHOUT HOLD--<cursor returnability> ::=- WITH RETURN- | WITHOUT RETURN--14.3 <cursor specification>--<cursor specification> ::=- <query expression> [ <updatability clause> ]--<updatability clause> ::=- FOR { READ ONLY | UPDATE [ OF <column name list> ] }--14.4 <open statement>--<open statement> ::=- OPEN <cursor name>--14.5 <fetch statement>--<fetch statement> ::=- FETCH [ [ <fetch orientation> ] FROM ] <cursor name> INTO <fetch target list>--<fetch orientation> ::=- NEXT- | PRIOR- | FIRST- | LAST- | { ABSOLUTE | RELATIVE } <simple value specification>--<fetch target list> ::=- <target specification> [ { <comma> <target specification> }... ]---14.6 <close statement>--<close statement> ::=- CLOSE <cursor name>--14.7 <select statement: single row>--<select statement: single row> ::=- SELECT [ <set quantifier> ] <select list>- INTO <select target list>- <table expression>--<select target list> ::=- <target specification> [ { <comma> <target specification> }... ]--14.8 <delete statement: positioned>--<delete statement: positioned> ::=- DELETE FROM <target table> [ [ AS ] <correlation name> ]- WHERE CURRENT OF <cursor name>--<target table> ::=- <table name>- | ONLY <left paren> <table name> <right paren>--14.9 <delete statement: searched>--<delete statement: searched> ::=- DELETE FROM <target table>- [ FOR PORTION OF <application time period name>- FROM <point in time 1> TO <point in time 2> ]- [ [ AS ] <correlation name> ]- [ WHERE <search condition> ]--> (TestStatement ansi2011 "delete from t"-> $ Delete [Name Nothing "t"] Nothing Nothing)--> ,(TestStatement ansi2011 "delete from t as u"-> $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing)--> ,(TestStatement ansi2011 "delete from t where x = 5"-> $ Delete [Name Nothing "t"] Nothing-> (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))---> ,(TestStatement ansi2011 "delete from t as u where u.x = 5"-> $ Delete [Name Nothing "t"] (Just (Name Nothing "u"))-> (Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))--14.10 <truncate table statement>--<truncate table statement> ::=- TRUNCATE TABLE <target table> [ <identity column restart option> ]--<identity column restart option> ::=- CONTINUE IDENTITY- | RESTART IDENTITY--> ,(TestStatement ansi2011 "truncate table t"-> $ Truncate [Name Nothing "t"] DefaultIdentityRestart)--> ,(TestStatement ansi2011 "truncate table t continue identity"-> $ Truncate [Name Nothing "t"] ContinueIdentity)--> ,(TestStatement ansi2011 "truncate table t restart identity"-> $ Truncate [Name Nothing "t"] RestartIdentity)---14.11 <insert statement>--<insert statement> ::=- INSERT INTO <insertion target> <insert columns and source>--<insertion target> ::=- <table name>--<insert columns and source> ::=- <from subquery>- | <from constructor>- | <from default>--<from subquery> ::=- [ <left paren> <insert column list> <right paren> ]- [ <override clause> ]- <query expression>--<from constructor> ::=- [ <left paren> <insert column list> <right paren> ]- [ <override clause> ]- <contextually typed table value constructor>--<override clause> ::=- OVERRIDING USER VALUE- | OVERRIDING SYSTEM VALUE--<from default> ::=- DEFAULT VALUES--<insert column list> ::=- <column name list>--> ,(TestStatement ansi2011 "insert into t select * from u"-> $ Insert [Name Nothing "t"] Nothing-> $ InsertQuery makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "u"]]})--> ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"-> $ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"])-> $ InsertQuery makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "u"]]})--> ,(TestStatement ansi2011 "insert into t default values"-> $ Insert [Name Nothing "t"] Nothing DefaultInsertValues)--> ,(TestStatement ansi2011 "insert into t values(1,2)"-> $ Insert [Name Nothing "t"] Nothing-> $ InsertQuery $ Values [[NumLit "1", NumLit "2"]])--> ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"-> $ Insert [Name Nothing "t"] Nothing-> $ InsertQuery $ Values [[NumLit "1", NumLit "2"]-> ,[NumLit "3", NumLit "4"]])--> ,(TestStatement ansi2011-> "insert into t values (default,null,array[],multiset[])"-> $ Insert [Name Nothing "t"] Nothing-> $ InsertQuery $ Values [[Iden [Name Nothing "default"]-> ,Iden [Name Nothing "null"]-> ,Array (Iden [Name Nothing "array"]) []-> ,MultisetCtor []]])---14.12 <merge statement>--<merge statement> ::=- MERGE INTO <target table> [ [ AS ] <merge correlation name> ]- USING <table reference>- ON <search condition> <merge operation specification>--merge into t- using t- on a = b- merge operation specification--merge into t as u-using (table factor | joined expression)-- MERGE INTO tablename USING table_reference ON (condition)- WHEN MATCHED THEN- UPDATE SET column1 = value1 [, column2 = value2 ...]- WHEN NOT MATCHED THEN- INSERT (column1 [, column2 ...]) VALUES (value1 [, value2 ...--merge into t23-using t42-on t42.id = t23.id-when matched then- update- set t23.col1 = t42.col1-when not matched then- insert (id, col1)- values (t42.id, t42.col1)----MERGE INTO TableA u--USING (SELECT b.Key1, b.ColB1, c.ColC1--FROM TableB b--INNER JOIN TableC c ON c.KeyC1 = b.KeyB1--) s--ON (u.KeyA1 = s.KeyA1)--WHEN MATCHED THEN--UPDATE SET u.ColA1 = s.ColB1, u.ColA2 = s.ColC1---MERGE INTO Department -USING NewDept AS ND -ON nd.Department_Number = Department.-Department_Number -WHEN MATCHED THEN UPDATE -SET budget_amount = nd.Budget_Amount -WHEN NOT MATCHED THEN INSERT -VALUES -(nd.Department_Number, nd.Department_-Name, nd.Budget_Amount, - nd.Manager_Employee_Number);---MERGE INTO Orders2 -USING Orders3 -ON ORDERS3.Order_Number = Orders2.-Order_Number -WHEN NOT MATCHED THEN INSERT -Orders3.order_number, Orders3.-invoice_number, - Orders3.customer_number, Orders3.-initial_order_date, - Orders3.invoice_date, Orders3.-invoice_amount);--MERGE INTO Orders2 -USING Orders3 -ON ORDERS3.Order_Number = Orders2.-Order_Number AND 1=0 -WHEN NOT MATCHED THEN INSERT -(Orders3.order_number, Orders3.invoice_number, - Orders3.customer_number, Orders3.-initial_order_date, - Orders3.invoice_date, Orders3.-invoice_amount);--MERGE INTO Department -USING NewDept AS ND -ON nd.Department_Number = Department.-Department_Number -WHEN MATCHED THEN UPDATE -SET budget_amount = nd.Budget_Amount -LOGGING ALL ERRORS WITH NO LIMIT;---MERGE INTO Department -USING - (SELECT Department_Number,-department_name, - Budget_Amount, -Manager_Employee_Number - FROM NewDept - WHERE Department_Number IN -(SELECT Department_Number - FROM Employee)) AS m-ON m.Department_Number = Department.-Department_Number -WHEN MATCHED THEN UPDATE -SET budget_amount = m.Budget_Amount -WHEN NOT MATCHED THEN INSERT -(m.Department_Number, m.Department_-Name, m.Budget_Amount, -m.Manager_Employee_Number) -LOGGING ALL ERRORS WITH NO LIMIT;-- -MERGE INTO Customers AS c-USING Moved AS m- ON m.SSN = c.SSN-WHEN MATCHED-THEN UPDATE-SET Street = m.Street,- HouseNo = m.HouseNo,- City = m.City;--MERGE INTO CentralOfficeAccounts AS C -- Target-USING BranchOfficeAccounts AS B -- Source- ON C.account_nbr = B.account_nbr-WHEN MATCHED THEN -- On match update- UPDATE SET C.company_name = B.company_name,- C.primary_contact = B.primary_contact,- C.contact_phone = B.contact_phone-WHEN NOT MATCHED THEN -- Add missing- INSERT (account_nbr, company_name, primary_contact, contact_phone)- VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);- -SELECT account_nbr, company_name, primary_contact, contact_phone -FROM CentralOfficeAccounts;----MERGE INTO CentralOfficeAccounts AS C -- Target-USING BranchOfficeAccounts AS B -- Source- ON C.account_nbr = B.account_nbr-WHEN MATCHED -- On match update- AND (C.company_name <> B.company_name -- Additional search conditions- OR C.primary_contact <> B.primary_contact- OR C.contact_phone <> B.contact_phone) THEN - UPDATE SET C.company_name = B.company_name,- C.primary_contact = B.primary_contact,- C.contact_phone = B.contact_phone-WHEN NOT MATCHED THEN -- Add missing- INSERT (account_nbr, company_name, primary_contact, contact_phone)- VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);----MERGE INTO CentralOfficeAccounts AS C -- Target-USING BranchOfficeAccounts AS B -- Source- ON C.account_nbr = B.account_nbr-WHEN MATCHED -- On match update- AND (C.company_name <> B.company_name -- Additional search conditions- OR C.primary_contact <> B.primary_contact- OR C.contact_phone <> B.contact_phone) THEN - UPDATE SET C.company_name = B.company_name,- C.primary_contact = B.primary_contact,- C.contact_phone = B.contact_phone-WHEN NOT MATCHED THEN -- Add missing- INSERT (account_nbr, company_name, primary_contact, contact_phone)- VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone)-WHEN SOURCE NOT MATCHED THEN -- Delete missing from source- DELETE;- -SELECT account_nbr, company_name, primary_contact, contact_phone -FROM CentralOfficeAccounts; -----<merge correlation name> ::=- <correlation name>--<merge operation specification> ::=- <merge when clause>...--<merge when clause> ::=- <merge when matched clause>- | <merge when not matched clause>--<merge when matched clause> ::=- WHEN MATCHED [ AND <search condition> ]- THEN <merge update or delete specification>--<merge update or delete specification> ::=- <merge update specification>- | <merge delete specification>--<merge when not matched clause> ::=- WHEN NOT MATCHED [ AND <search condition> ]- THEN <merge insert specification>--<merge update specification> ::=- UPDATE SET <set clause list>--<merge delete specification> ::=- DELETE--<merge insert specification> ::=- INSERT [ <left paren> <insert column list> <right paren> ]- [ <override clause> ]- VALUES <merge insert value list>--<merge insert value list> ::=- <left paren>- <merge insert value element> [ { <comma> <merge insert value element> }... ]- <right paren>--<merge insert value element> ::=- <value expression>- | <contextually typed value specification>--14.13 <update statement: positioned>--<updatestatement: positioned> ::=- UPDATE <target table> [ [ AS ] <correlation name> ]- SET <set clause list>- WHERE CURRENT OF <cursor name>--14.14 <update statement: searched>--<update statement: searched> ::=- UPDATE <target table>- [ FOR PORTION OF <application time period name>- FROM <point in time 1> TO <point in time 2> ]- [ [ AS ] <correlation name> ]- SET <set clause list>- [ WHERE <search condition> ]---> ,(TestStatement ansi2011 "update t set a=b"-> $ Update [Name Nothing "t"] Nothing-> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)--> ,(TestStatement ansi2011 "update t set a=b, c=5"-> $ Update [Name Nothing "t"] Nothing-> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])-> ,Set [Name Nothing "c"] (NumLit "5")] Nothing)---> ,(TestStatement ansi2011 "update t set a=b where a>5"-> $ Update [Name Nothing "t"] Nothing-> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]-> $ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))---> ,(TestStatement ansi2011 "update t as u set a=b where u.a>5"-> $ Update [Name Nothing "t"] (Just $ Name Nothing "u")-> [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]-> $ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"])-> [Name Nothing ">"] (NumLit "5"))--> ,(TestStatement ansi2011 "update t set (a,b)=(3,5)"-> $ Update [Name Nothing "t"] Nothing-> [SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]-> [NumLit "3", NumLit "5"]] Nothing)----14.15 <set clause list>--<set clause list> ::=- <set clause> [ { <comma> <set clause> }... ]--<set clause> ::=- <multiple column assignment>- | <set target> <equals operator> <update source>--<set target> ::=- <update target>- | <mutated set clause>--<multiple column assignment> ::=- <set target list> <equals operator> <assigned row>--<set target list> ::=- <left paren> <set target> [ { <comma> <set target> }... ] <right paren>--<assigned row> ::=- <contextually typed row value expression>--<update target> ::=- <object column>- | <object column>- <left bracket or trigraph> <simple value specification> <right bracket or trigraph>--<object column> ::=- <column name>--<mutated set clause> ::=- <mutated target> <period> <method name>--<mutated target> ::=- <object column>- | <mutated set clause>--<update source> ::=- <value expression>- | <contextually typed value specification>--14.16 <temporary table declaration>--<temporary table declaration> ::=- DECLARE LOCAL TEMPORARY TABLE <table name> <table element list>- [ ON COMMIT <table commit action> ROWS ]--declare local temporary table t (a int) [on commit {preserve | delete} rows]--14.17 <free locator statement>--<free locator statement> ::=- FREE LOCATOR <locator reference> [ { <comma> <locator reference> }... ]--<locator reference> ::=- <host parameter name>- | <embedded variable name>- | <dynamic parameter specification>--14.18 <hold locator statement>--<hold locator statement> ::=- HOLD LOCATOR <locator reference> [ { <comma> <locator reference> }... ]---> ]
− tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs
@@ -1,4341 +0,0 @@--This file goes through the grammar for SQL 2011 queries (using the-draft standard).--There are other files which cover some of the other sections from SQL-2011 (ddl, non-query dml, etc).--Possible sections not in the todo which could-be covered:--13 modules-16 control statements-18 connection management-20 dynamic-22 direct-23 diagnostics--procedural sql--some of the main areas being left for now:-temporal and versioning stuff-modules-ref stuff-todo: finish this list----The goal is to create some example tests for each bit of grammar, with-some areas getting more comprehensive coverage tests, and also to note-which parts aren't currently supported.--> module Language.SQL.SimpleSQL.SQL2011Queries (sql2011QueryTests) where-> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> sql2011QueryTests :: TestItem-> sql2011QueryTests = Group "sql 2011 query tests"-> [literals-> ,identifiers-> ,typeNameTests-> ,fieldDefinition-> ,valueExpressions-> ,queryExpressions-> ,scalarSubquery-> ,predicates-> ,intervalQualifier-> ,collateClause-> ,aggregateFunction-> ,sortSpecificationList-> ]--= 5 Lexical elements--The tests don't make direct use of these definitions.--== 5.1 <SQL terminal character>--Function--Define the terminal symbols of the SQL language and the elements of-strings.--<SQL terminal character> ::= <SQL language character>--<SQL language character> ::=- <simple Latin letter>- | <digit>- | <SQL special character>--<simple Latin letter> ::=- <simple Latin upper case letter>- | <simple Latin lower case letter>--<simple Latin upper case letter> ::=- A | B | C | D | E | F | G | H | I | J | K | L | M | N | O- | P | Q | R | S | T | U | V | W | X | Y | Z--<simple Latin lower case letter> ::=- a | b | c | d | e | f | g | h | i | j | k | l | m | n | o- | p | q | r | s | t | u | v | w | x | y | z--<digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9--<SQL special character> ::=- <space>- | <double quote>- | <percent>- | <ampersand>- | <quote>- | <left paren>- | <right paren>- | <asterisk>- | <plus sign>- | <comma>- | <minus sign>- | <period>- | <solidus>- | <colon>- | <semicolon>- | <less than operator>- | <equals operator>- | <greater than operator>- | <question mark>- | <left bracket>- | <right bracket>- | <circumflex>- | <underscore>- | <vertical bar>- | <left brace>- | <right brace>--<space> ::= !! See the Syntax Rules.--<double quote> ::= "--<percent> ::= %--<ampersand> ::= &--<quote> ::= '--<left paren> ::= (--<right paren> ::= )--<asterisk> ::= *--<plus sign> ::= +--<comma> ::= ,--<minus sign> ::= ---<period> ::= .--<solidus> ::= /--<reverse solidus> ::= \--<colon> ::= :--<semicolon> ::= ;--<less than operator> ::= <--<equals operator> ::= =--<greater than operator> ::= >--<question mark> ::= ?--<left bracket or trigraph> ::= <left bracket> | <left bracket trigraph>--<right bracket or trigraph> ::= <right bracket> | <right bracket trigraph>--<left bracket> ::= [--<left bracket trigraph> ::= ??(--<right bracket> ::= ]--<right bracket trigraph> ::= ??)--<circumflex> ::= ^--<underscore> ::= _--<vertical bar> ::= |--<left brace> ::= {--<right brace> ::= }--== 5.2 <token> and <separator>--Function--Specify lexical units (tokens and separators) that participate in SQL-language.--<token> ::= <nondelimiter token> | <delimiter token>--<nondelimiter token> ::=- <regular identifier>- | <key word>- | <unsigned numeric literal>- | <national character string literal>- | <binary string literal>- | <large object length token>- | <Unicode delimited identifier>- | <Unicode character string literal>- | <SQL language identifier>--<regular identifier> ::= <identifier body>--<identifier body> ::= <identifier start> [ <identifier part>... ]--<identifier part> ::= <identifier start> | <identifier extend>--<identifier start> ::= !! See the Syntax Rules.--<identifier extend> ::= !! See the Syntax Rules.--<large object length token> ::= <digit>... <multiplier>--<multiplier> ::= K | M | G | T | P--<delimited identifier> ::=- <double quote> <delimited identifier body> <double quote>--<delimited identifier body> ::= <delimited identifier part>...--<delimited identifier part> ::=- <nondoublequote character>- | <doublequote symbol>--<Unicode delimited identifier> ::=- U <ampersand> <double quote> <Unicode delimiter body> <double quote>- <Unicode escape specifier>--<Unicode escape specifier> ::=- [ UESCAPE <quote> <Unicode escape character> <quote> ]--<Unicode delimiter body> ::= <Unicode identifier part>...--<Unicode identifier part> ::=- <delimited identifier part>- | <Unicode escape value>--<Unicode escape value> ::=- <Unicode 4 digit escape value>- | <Unicode 6 digit escape value>- | <Unicode character escape value>--<Unicode 4 digit escape value> ::=- <Unicode escape character> <hexit> <hexit> <hexit> <hexit>--<Unicode 6 digit escape value> ::=- <Unicode escape character> <plus sign>- <hexit> <hexit> <hexit> <hexit> <hexit> <hexit>--<Unicode character escape value> ::=- <Unicode escape character> <Unicode escape character>--<Unicode escape character> ::= !! See the Syntax Rules.--<nondoublequote character> ::= !! See the Syntax Rules.--<doublequote symbol> ::= ""!! two consecutive double quote characters--<delimiter token> ::=- <character string literal>- | <date string>- | <time string>- | <timestamp string>- | <interval string>- | <delimited identifier>- | <SQL special character>- | <not equals operator>- | <greater than or equals operator>- | <less than or equals operator>- | <concatenation operator>- | <right arrow>- | <left bracket trigraph>- | <right bracket trigraph>- | <double colon>- | <double period>- | <named argument assignment token>--<not equals operator> ::= <>--<greater than or equals operator> ::= >=--<less than or equals operator> ::= <=--<concatenation operator> ::= ||--<right arrow> ::= ->--<double colon> ::= ::--<double period> ::= ..--<named argument assignment token> ::= =>--<separator> ::= { <comment> | <white space> }...--<white space> ::= !! See the Syntax Rules.--<comment> ::= <simple comment> | <bracketed comment>--<simple comment> ::=- <simple comment introducer> [ <comment character>... ] <newline>--<simple comment introducer> ::= <minus sign> <minus sign>--<bracketed comment> ::=- <bracketed comment introducer>- <bracketed comment contents>- <bracketed comment terminator>--<bracketed comment introducer> ::= /*--<bracketed comment terminator> ::= */--<bracketed comment contents> ::=- [ { <comment character> | <separator> }... ]!! See the Syntax Rules.--<comment character> ::= <nonquote character> | <quote>--<newline> ::= !! See the Syntax Rules.--<key word> ::= <reserved word> | <non-reserved word>--<non-reserved word> ::=- A | ABSOLUTE | ACTION | ADA | ADD | ADMIN | AFTER | ALWAYS | ASC- | ASSERTION | ASSIGNMENT | ATTRIBUTE | ATTRIBUTES-- | BEFORE | BERNOULLI | BREADTH-- | C | CASCADE | CATALOG | CATALOG_NAME | CHAIN | CHARACTER_SET_CATALOG- | CHARACTER_SET_NAME | CHARACTER_SET_SCHEMA | CHARACTERISTICS | CHARACTERS- | CLASS_ORIGIN | COBOL | COLLATION | COLLATION_CATALOG | COLLATION_NAME | COLLATION_SCHEMA- | COLUMN_NAME | COMMAND_FUNCTION | COMMAND_FUNCTION_CODE | COMMITTED- | CONDITION_NUMBER | CONNECTION | CONNECTION_NAME | CONSTRAINT_CATALOG | CONSTRAINT_NAME- | CONSTRAINT_SCHEMA | CONSTRAINTS | CONSTRUCTOR | CONTINUE | CURSOR_NAME-- | DATA | DATETIME_INTERVAL_CODE | DATETIME_INTERVAL_PRECISION | DEFAULTS | DEFERRABLE- | DEFERRED | DEFINED | DEFINER | DEGREE | DEPTH | DERIVED | DESC | DESCRIPTOR- | DIAGNOSTICS | DISPATCH | DOMAIN | DYNAMIC_FUNCTION | DYNAMIC_FUNCTION_CODE-- | ENFORCED | EXCLUDE | EXCLUDING | EXPRESSION-- | FINAL | FIRST | FLAG | FOLLOWING | FORTRAN | FOUND-- | G | GENERAL | GENERATED | GO | GOTO | GRANTED-- | HIERARCHY-- | IGNORE | IMMEDIATE | IMMEDIATELY | IMPLEMENTATION | INCLUDING | INCREMENT | INITIALLY- | INPUT | INSTANCE | INSTANTIABLE | INSTEAD | INVOKER | ISOLATION-- | K | KEY | KEY_MEMBER | KEY_TYPE-- | LAST | LENGTH | LEVEL | LOCATOR-- | M | MAP | MATCHED | MAXVALUE | MESSAGE_LENGTH | MESSAGE_OCTET_LENGTH- | MESSAGE_TEXT | MINVALUE | MORE | MUMPS-- | NAME | NAMES | NESTING | NEXT | NFC | NFD | NFKC | NFKD- | NORMALIZED | NULLABLE | NULLS | NUMBER-- | OBJECT | OCTETS | OPTION | OPTIONS | ORDERING | ORDINALITY | OTHERS- | OUTPUT | OVERRIDING-- | P | PAD | PARAMETER_MODE | PARAMETER_NAME | PARAMETER_ORDINAL_POSITION- | PARAMETER_SPECIFIC_CATALOG | PARAMETER_SPECIFIC_NAME | PARAMETER_SPECIFIC_SCHEMA- | PARTIAL | PASCAL | PATH | PLACING | PLI | PRECEDING | PRESERVE | PRIOR- | PRIVILEGES | PUBLIC-- | READ | RELATIVE | REPEATABLE | RESPECT | RESTART | RESTRICT | RETURNED_CARDINALITY- | RETURNED_LENGTH | RETURNED_OCTET_LENGTH | RETURNED_SQLSTATE | ROLE- | ROUTINE | ROUTINE_CATALOG | ROUTINE_NAME | ROUTINE_SCHEMA | ROW_COUNT-- | SCALE | SCHEMA | SCHEMA_NAME | SCOPE_CATALOG | SCOPE_NAME | SCOPE_SCHEMA- | SECTION | SECURITY | SELF | SEQUENCE | SERIALIZABLE | SERVER_NAME | SESSION- | SETS | SIMPLE | SIZE | SOURCE | SPACE | SPECIFIC_NAME | STATE | STATEMENT- | STRUCTURE | STYLE | SUBCLASS_ORIGIN-- | T | TABLE_NAME | TEMPORARY | TIES | TOP_LEVEL_COUNT | TRANSACTION- | TRANSACTION_ACTIVE | TRANSACTIONS_COMMITTED | TRANSACTIONS_ROLLED_BACK- | TRANSFORM | TRANSFORMS | TRIGGER_CATALOG | TRIGGER_NAME | TRIGGER_SCHEMA | TYPE-- | UNBOUNDED | UNCOMMITTED | UNDER | UNNAMED | USAGE | USER_DEFINED_TYPE_CATALOG- | USER_DEFINED_TYPE_CODE | USER_DEFINED_TYPE_NAME | USER_DEFINED_TYPE_SCHEMA-- | VIEW-- | WORK | WRITE-- | ZONE--<reserved word> ::=- ABS | ALL | ALLOCATE | ALTER | AND | ANY | ARE | ARRAY | ARRAY_AGG- | ARRAY_MAX_CARDINALITY | AS | ASENSITIVE | ASYMMETRIC | AT | ATOMIC | AUTHORIZATION- | AVG-- | BEGIN | BEGIN_FRAME | BEGIN_PARTITION | BETWEEN | BIGINT | BINARY- | BLOB | BOOLEAN | BOTH | BY-- | CALL | CALLED | CARDINALITY | CASCADED | CASE | CAST | CEIL | CEILING- | CHAR | CHAR_LENGTH | CHARACTER | CHARACTER_LENGTH | CHECK | CLOB | CLOSE- | COALESCE | COLLATE | COLLECT | COLUMN | COMMIT | CONDITION | CONNECT- | CONSTRAINT | CONTAINS | CONVERT | CORR | CORRESPONDING | COUNT | COVAR_POP- | COVAR_SAMP | CREATE | CROSS | CUBE | CUME_DIST | CURRENT | CURRENT_CATALOG- | CURRENT_DATE | CURRENT_DEFAULT_TRANSFORM_GROUP | CURRENT_PATH | CURRENT_ROLE- | CURRENT_ROW | CURRENT_SCHEMA | CURRENT_TIME | CURRENT_TIMESTAMP- | CURRENT_TRANSFORM_GROUP_FOR_TYPE | CURRENT_USER | CURSOR | CYCLE-- | DATE | DAY | DEALLOCATE | DEC | DECIMAL | DECLARE | DEFAULT | DELETE- | DENSE_RANK | DEREF | DESCRIBE | DETERMINISTIC | DISCONNECT | DISTINCT- | DOUBLE | DROP | DYNAMIC-- | EACH | ELEMENT | ELSE | END | END_FRAME | END_PARTITION | END-EXEC- | EQUALS | ESCAPE | EVERY | EXCEPT | EXEC | EXECUTE | EXISTS | EXP- | EXTERNAL | EXTRACT-- | FALSE | FETCH | FILTER | FIRST_VALUE | FLOAT | FLOOR | FOR | FOREIGN- | FRAME_ROW | FREE | FROM | FULL | FUNCTION | FUSION-- | GET | GLOBAL | GRANT | GROUP | GROUPING | GROUPS-- | HAVING | HOLD | HOUR-- | IDENTITY | IN | INDICATOR | INNER | INOUT | INSENSITIVE | INSERT- | INT | INTEGER | INTERSECT | INTERSECTION | INTERVAL | INTO | IS-- | JOIN-- | LAG | LANGUAGE | LARGE | LAST_VALUE | LATERAL | LEAD | LEADING | LEFT- | LIKE | LIKE_REGEX | LN | LOCAL | LOCALTIME | LOCALTIMESTAMP | LOWER-- | MATCH | MAX | MEMBER | MERGE | METHOD | MIN | MINUTE- | MOD | MODIFIES | MODULE | MONTH | MULTISET-- | NATIONAL | NATURAL | NCHAR | NCLOB | NEW | NO | NONE | NORMALIZE | NOT- | NTH_VALUE | NTILE | NULL | NULLIF | NUMERIC-- | OCTET_LENGTH | OCCURRENCES_REGEX | OF | OFFSET | OLD | ON | ONLY | OPEN- | OR | ORDER | OUT | OUTER | OVER | OVERLAPS | OVERLAY-- | PARAMETER | PARTITION | PERCENT | PERCENT_RANK | PERCENTILE_CONT- | PERCENTILE_DISC | PERIOD | PORTION | POSITION | POSITION_REGEX | POWER | PRECEDES- | PRECISION | PREPARE | PRIMARY | PROCEDURE-- | RANGE | RANK | READS | REAL | RECURSIVE | REF | REFERENCES | REFERENCING- | REGR_AVGX | REGR_AVGY | REGR_COUNT | REGR_INTERCEPT | REGR_R2 | REGR_SLOPE- | REGR_SXX | REGR_SXY | REGR_SYY | RELEASE | RESULT | RETURN | RETURNS- | REVOKE | RIGHT | ROLLBACK | ROLLUP | ROW | ROW_NUMBER | ROWS-- | SAVEPOINT | SCOPE | SCROLL | SEARCH | SECOND | SELECT- | SENSITIVE | SESSION_USER | SET | SIMILAR | SMALLINT | SOME | SPECIFIC- | SPECIFICTYPE | SQL | SQLEXCEPTION | SQLSTATE | SQLWARNING | SQRT | START- | STATIC | STDDEV_POP | STDDEV_SAMP | SUBMULTISET | SUBSTRING | SUBSTRING_REGEX- | SUCCEEDS | SUM | SYMMETRIC | SYSTEM | SYSTEM_TIME | SYSTEM_USER-- | TABLE | TABLESAMPLE | THEN | TIME | TIMESTAMP | TIMEZONE_HOUR | TIMEZONE_MINUTE- | TO | TRAILING | TRANSLATE | TRANSLATE_REGEX | TRANSLATION | TREAT- | TRIGGER | TRUNCATE | TRIM | TRIM_ARRAY | TRUE-- | UESCAPE | UNION | UNIQUE | UNKNOWN | UNNEST | UPDATE | UPPER | USER | USING-- | VALUE | VALUES | VALUE_OF | VAR_POP | VAR_SAMP | VARBINARY- | VARCHAR | VARYING | VERSIONING-- | WHEN | WHENEVER | WHERE | WIDTH_BUCKET | WINDOW | WITH | WITHIN | WITHOUT-- | YEAR--== 5.3 <literal>--Function-Specify a non-null value.--> literals :: TestItem-> literals = Group "literals"-> [numericLiterals,generalLiterals]--<literal> ::= <signed numeric literal> | <general literal>--<unsigned literal> ::= <unsigned numeric literal> | <general literal>--<general literal> ::=- <character string literal>- | <national character string literal>- | <Unicode character string literal>- | <binary string literal>- | <datetime literal>- | <interval literal>- | <boolean literal>--> generalLiterals :: TestItem-> generalLiterals = Group "general literals"-> [characterStringLiterals-> ,nationalCharacterStringLiterals-> ,unicodeCharacterStringLiterals-> ,binaryStringLiterals-> ,dateTimeLiterals-> ,intervalLiterals-> ,booleanLiterals]--<character string literal> ::=- [ <introducer> <character set specification> ]- <quote> [ <character representation>... ] <quote>- [ { <separator> <quote> [ <character representation>... ] <quote> }... ]--<introducer> ::= <underscore>--<character representation> ::= <nonquote character> | <quote symbol>--<nonquote character> ::= !! See the Syntax Rules.--<quote symbol> ::= <quote> <quote>--> characterStringLiterals :: TestItem-> characterStringLiterals = Group "character string literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("'a regular string literal'"-> ,StringLit "'" "'" "a regular string literal")-> ,("'something' ' some more' 'and more'"-> ,StringLit "'" "'" "something some moreand more")-> ,("'something' \n ' some more' \t 'and more'"-> ,StringLit "'" "'" "something some moreand more")-> ,("'something' -- a comment\n ' some more' /*another comment*/ 'and more'"-> ,StringLit "'" "'" "something some moreand more")-> ,("'a quote: '', stuff'"-> ,StringLit "'" "'" "a quote: '', stuff")-> ,("''"-> ,StringLit "'" "'" "")--I'm not sure how this should work. Maybe the parser should reject non-ascii characters in strings and identifiers unless the current SQL-character set allows them.--> ,("_francais 'français'"-> ,TypedLit (TypeName [Name Nothing "_francais"]) "français")-> ]--<national character string literal> ::=- N <quote> [ <character representation>... ]- <quote> [ { <separator> <quote> [ <character representation>... ] <quote> }... ]--> nationalCharacterStringLiterals :: TestItem-> nationalCharacterStringLiterals = Group "national character string literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("N'something'", StringLit "N'" "'" "something")-> ,("n'something'", StringLit "n'" "'" "something")-> ]--<Unicode character string literal> ::=- [ <introducer> <character set specification> ]- U <ampersand> <quote> [ <Unicode representation>... ] <quote>- [ { <separator> <quote> [ <Unicode representation>... ] <quote> }... ]- <Unicode escape specifier>--<Unicode representation> ::=- <character representation>- | <Unicode escape value>--> unicodeCharacterStringLiterals :: TestItem-> unicodeCharacterStringLiterals = Group "unicode character string literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("U&'something'", StringLit "U&'" "'" "something")-> {-,("u&'something' escape ="-> ,Escape (StringLit "u&'" "'" "something") '=')-> ,("u&'something' uescape ="-> ,UEscape (StringLit "u&'" "'" "something") '=')-}-> ]--TODO: unicode escape--<binary string literal> ::=- X <quote> [ <space>... ] [ { <hexit> [ <space>... ] <hexit> [ <space>... ] }... ] <quote>- [ { <separator> <quote> [ <space>... ] [ { <hexit> [ <space>... ]- <hexit> [ <space>... ] }... ] <quote> }... ]--<hexit> ::= <digit> | A | B | C | D | E | F | a | b | c | d | e | f--> binaryStringLiterals :: TestItem-> binaryStringLiterals = Group "binary string literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [--("B'101010'", CSStringLit "B" "101010")-> ("X'7f7f7f'", StringLit "X'" "'" "7f7f7f")-> --,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z')-> ]--<signed numeric literal> ::= [ <sign> ] <unsigned numeric literal>--<unsigned numeric literal> ::=- <exact numeric literal>- | <approximate numeric literal>--<exact numeric literal> ::=- <unsigned integer> [ <period> [ <unsigned integer> ] ]- | <period> <unsigned integer>--<sign> ::= <plus sign> | <minus sign>--<approximate numeric literal> ::= <mantissa> E <exponent>--<mantissa> ::= <exact numeric literal>--<exponent> ::= <signed integer>--<signed integer> ::= [ <sign> ] <unsigned integer>--<unsigned integer> ::= <digit>...--> numericLiterals :: TestItem-> numericLiterals = Group "numeric literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("11", NumLit "11")-> ,("11.11", NumLit "11.11")--> ,("11E23", NumLit "11E23")-> ,("11E+23", NumLit "11E+23")-> ,("11E-23", NumLit "11E-23")--> ,("11.11E23", NumLit "11.11E23")-> ,("11.11E+23", NumLit "11.11E+23")-> ,("11.11E-23", NumLit "11.11E-23")--> ,("+11E23", PrefixOp [Name Nothing "+"] $ NumLit "11E23")-> ,("+11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11E+23")-> ,("+11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11E-23")-> ,("+11.11E23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E23")-> ,("+11.11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23")-> ,("+11.11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23")--> ,("-11E23", PrefixOp [Name Nothing "-"] $ NumLit "11E23")-> ,("-11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11E+23")-> ,("-11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11E-23")-> ,("-11.11E23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E23")-> ,("-11.11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23")-> ,("-11.11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23")--> ,("11.11e23", NumLit "11.11e23")--> ]--<datetime literal> ::= <date literal> | <time literal> | <timestamp literal>--<date literal> ::= DATE <date string>--<time literal> ::= TIME <time string>--<timestamp literal> ::= TIMESTAMP <timestamp string>--<date string> ::= <quote> <unquoted date string> <quote>--<time string> ::= <quote> <unquoted time string> <quote>--<timestamp string> ::= <quote> <unquoted timestamp string> <quote>--<time zone interval> ::= <sign> <hours value> <colon> <minutes value>--<date value> ::=- <years value> <minus sign> <months value> <minus sign> <days value>--<time value> ::= <hours value> <colon> <minutes value> <colon> <seconds value>--> dateTimeLiterals :: TestItem-> dateTimeLiterals = Group "datetime literals"-> [-- TODO: datetime literals-> ]--<interval literal> ::=- INTERVAL [ <sign> ] <interval string> <interval qualifier>--<interval string> ::= <quote> <unquoted interval string> <quote>--<unquoted date string> ::= <date value>--<unquoted time string> ::= <time value> [ <time zone interval> ]--<unquoted timestamp string> ::=- <unquoted date string> <space> <unquoted time string>--<unquoted interval string> ::=- [ <sign> ] { <year-month literal> | <day-time literal> }--<year-month literal> ::=- <years value> [ <minus sign> <months value> ]- | <months value>--<day-time literal> ::= <day-time interval> | <time interval>--<day-time interval> ::=- <days value> [ <space> <hours value> [ <colon> <minutes value>- [ <colon> <seconds value> ] ] ]--<time interval> ::=- <hours value> [ <colon> <minutes value> [ <colon> <seconds value> ] ]- | <minutes value> [ <colon> <seconds value> ]- | <seconds value>--<years value> ::= <datetime value>--<months value> ::= <datetime value>--<days value> ::= <datetime value>--<hours value> ::= <datetime value>--<minutes value> ::= <datetime value>--<seconds value> ::= <seconds integer value> [ <period> [ <seconds fraction> ] ]--<seconds integer value> ::= <unsigned integer>--<seconds fraction> ::= <unsigned integer>--<datetime value> ::= <unsigned integer>--> intervalLiterals :: TestItem-> intervalLiterals = Group "intervalLiterals literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("interval '1'", TypedLit (TypeName [Name Nothing "interval"]) "1")-> ,("interval '1' day"-> ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)-> ,("interval '1' day(3)"-> ,IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing)-> ,("interval + '1' day(3)"-> ,IntervalLit (Just Plus) "1" (Itf "day" $ Just (3,Nothing)) Nothing)-> ,("interval - '1' second(2,2)"-> ,IntervalLit (Just Minus) "1" (Itf "second" $ Just (2,Just 2)) Nothing)-> ,("interval '1' year to month"-> ,IntervalLit Nothing "1" (Itf "year" Nothing)-> (Just $ Itf "month" Nothing))--> ,("interval '1' year(4) to second(2,3) "-> ,IntervalLit Nothing "1" (Itf "year" $ Just (4,Nothing))-> (Just $ Itf "second" $ Just (2, Just 3)))-> ]--<boolean literal> ::= TRUE | FALSE | UNKNOWN--> booleanLiterals :: TestItem-> booleanLiterals = Group "boolean literals"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("true", Iden [Name Nothing "true"])-> ,("false", Iden [Name Nothing "false"])-> ,("unknown", Iden [Name Nothing "unknown"])-> ]--== 5.4 Names and identifiers--Function-Specify names.--<identifier> ::= <actual identifier>--<actual identifier> ::=- <regular identifier>- | <delimited identifier>- | <Unicode delimited identifier>--> identifiers :: TestItem-> identifiers = Group "identifiers"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("test",Iden [Name Nothing "test"])-> ,("_test",Iden [Name Nothing "_test"])-> ,("t1",Iden [Name Nothing "t1"])-> ,("a.b",Iden [Name Nothing "a", Name Nothing "b"])-> ,("a.b.c",Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"])-> ,("\"quoted iden\"", Iden [Name (Just ("\"","\"")) "quoted iden"])-> ,("\"quoted \"\" iden\"", Iden [Name (Just ("\"","\"")) "quoted \"\" iden"])-> ,("U&\"quoted iden\"", Iden [Name (Just ("U&\"","\"")) "quoted iden"])-> ,("U&\"quoted \"\" iden\"", Iden [Name (Just ("U&\"","\"")) "quoted \"\" iden"])-> ]--TODO: more identifiers, e.g. unicode escapes?, mixed quoted/unquoted-chains--TODO: review below stuff for exact rules--<SQL language identifier> ::=- <SQL language identifier start> [ <SQL language identifier part>... ]--<SQL language identifier start> ::= <simple Latin letter>--<SQL language identifier part> ::=- <simple Latin letter>- | <digit>- | <underscore>--<authorization identifier> ::= <role name> | <user identifier>--<table name> ::= <local or schema qualified name>--<domain name> ::= <schema qualified name>--<schema name> ::= [ <catalog name> <period> ] <unqualified schema name>--<unqualified schema name> ::= <identifier>--<catalog name> ::= <identifier>--<schema qualified name> ::= [ <schema name> <period> ] <qualified identifier>--<local or schema qualified name> ::=- [ <local or schema qualifier> <period> ] <qualified identifier>--<local or schema qualifier> ::= <schema name> | <local qualifier>--<qualified identifier> ::= <identifier>--<column name> ::= <identifier>--<correlation name> ::= <identifier>--<query name> ::= <identifier>--<SQL-client module name> ::= <identifier>--<procedure name> ::= <identifier>--<schema qualified routine name> ::= <schema qualified name>--<method name> ::= <identifier>--<specific name> ::= <schema qualified name>--<cursor name> ::= <local qualified name>--<local qualified name> ::=- [ <local qualifier> <period> ] <qualified identifier>--<local qualifier> ::= MODULE--<host parameter name> ::= <colon> <identifier>--<SQL parameter name> ::= <identifier>--<constraint name> ::= <schema qualified name>--<external routine name> ::= <identifier> | <character string literal>--<trigger name> ::= <schema qualified name>--<collation name> ::= <schema qualified name>--<character set name> ::= [ <schema name> <period> ] <SQL language identifier>--<transliteration name> ::= <schema qualified name>--<transcoding name> ::= <schema qualified name>--<schema-resolved user-defined type name> ::= <user-defined type name>--<user-defined type name> ::= [ <schema name> <period> ] <qualified identifier>--<attribute name> ::= <identifier>--<field name> ::= <identifier>--<savepoint name> ::= <identifier>--<sequence generator name> ::= <schema qualified name>--<role name> ::= <identifier>--<user identifier> ::= <identifier>--<connection name> ::= <simple value specification>--<SQL-server name> ::= <simple value specification>--<connection user name> ::= <simple value specification>--<SQL statement name> ::= <statement name> | <extended statement name>--<statement name> ::= <identifier>--<extended statement name> ::= [ <scope option> ] <simple value specification>--<dynamic cursor name> ::= <cursor name> | <extended cursor name>--<extended cursor name> ::= [ <scope option> ] <simple value specification>--<descriptor name> ::=- <non-extended descriptor name>- | <extended descriptor name>--<non-extended descriptor name> ::= <identifier>--<extended descriptor name> ::= [ <scope option> ] <simple value specification>--<scope option> ::= GLOBAL | LOCAL--<window name> ::= <identifier>--= 6 Scalar expressions--== 6.1 <data type>--Function-Specify a data type.--<data type> ::=- <predefined type>- | <row type>- | <path-resolved user-defined type name>- | <reference type>- | <collection type>--<predefined type> ::=- <character string type> [ CHARACTER SET <character set specification> ]- [ <collate clause> ]- | <national character string type> [ <collate clause> ]- | <binary string type>- | <numeric type>- | <boolean type>- | <datetime type>- | <interval type>--<character string type> ::=- CHARACTER [ <left paren> <character length> <right paren> ]- | CHAR [ <left paren> <character length> <right paren> ]- | CHARACTER VARYING <left paren> <character length> <right paren>- | CHAR VARYING <left paren> <character length> <right paren>- | VARCHAR <left paren> <character length> <right paren>- | <character large object type>--<character large object type> ::=- CHARACTER LARGE OBJECT [ <left paren> <character large object length> <right paren> ]- | CHAR LARGE OBJECT [ <left paren> <character large object length> <right paren> ]- | CLOB [ <left paren> <character large object length> <right paren> ]--<national character string type> ::=- NATIONAL CHARACTER [ <left paren> <character length> <right paren> ]- | NATIONAL CHAR [ <left paren> <character length> <right paren> ]- | NCHAR [ <left paren> <character length> <right paren> ]- | NATIONAL CHARACTER VARYING <left paren> <character length> <right paren>- | NATIONAL CHAR VARYING <left paren> <character length> <right paren>- | NCHAR VARYING <left paren> <character length> <right paren>- | <national character large object type>--<national character large object type> ::=- NATIONAL CHARACTER LARGE OBJECT [ <left paren> <character large object length> <right- paren> ]- | NCHAR LARGE OBJECT [ <left paren> <character large object length> <right paren> ]- | NCLOB [ <left paren> <character large object length> <right paren> ]--<binary string type> ::=- BINARY [ <left paren> <length> <right paren> ]- | BINARY VARYING <left paren> <length> <right paren>- | VARBINARY <left paren> <length> <right paren>- | <binary large object string type>--<binary large object string type> ::=- BINARY LARGE OBJECT [ <left paren> <large object length> <right paren> ]- | BLOB [ <left paren> <large object length> <right paren> ]--<numeric type> ::= <exact numeric type> | <approximate numeric type>--<exact numeric type> ::=- NUMERIC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]- | DECIMAL [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]- | DEC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]- | SMALLINT- | INTEGER- | INT- | BIGINT--<approximate numeric type> ::=- FLOAT [ <left paren> <precision> <right paren> ]- | REAL- | DOUBLE PRECISION--<length> ::= <unsigned integer>--<character length> ::= <length> [ <char length units> ]--<large object length> ::=- <length> [ <multiplier> ]- | <large object length token>--<character large object length> ::=- <large object length> [ <char length units> ]--<char length units> ::= CHARACTERS | OCTETS--<precision> ::= <unsigned integer>--<scale> ::= <unsigned integer>--<boolean type> ::= BOOLEAN--<datetime type> ::=- DATE- | TIME [ <left paren> <time precision> <right paren> ] [ <with or without time zone> ]- | TIMESTAMP [ <left paren> <timestamp precision> <right paren> ]- [ <with or without time zone> ]--<with or without time zone> ::= WITH TIME ZONE | WITHOUT TIME ZONE--<time precision> ::= <time fractional seconds precision>--<timestamp precision> ::= <time fractional seconds precision>--<time fractional seconds precision> ::= <unsigned integer>--<interval type> ::= INTERVAL <interval qualifier>--<row type> ::= ROW <row type body>--<row type body> ::=- <left paren> <field definition> [ { <comma> <field definition> }... ] <right paren>--<reference type> ::=- REF <left paren> <referenced type> <right paren> [ <scope clause> ]--<scope clause> ::= SCOPE <table name>--<referenced type> ::= <path-resolved user-defined type name>--<path-resolved user-defined type name> ::= <user-defined type name>--<collection type> ::= <array type> | <multiset type>--<array type> ::=- <data type> ARRAY- [ <left bracket or trigraph> <maximum cardinality> <right bracket or trigraph> ]--<maximum cardinality> ::= <unsigned integer>--<multiset type> ::= <data type> MULTISET--TODO: below, add new stuff:-review the length syntaxes-binary, binary varying/varbinary-new multipliers--create a list of type name variations:--> typeNames :: ([(String,TypeName)],[(String,TypeName)])-> typeNames =-> (basicTypes, concatMap makeArray basicTypes-> ++ map makeMultiset basicTypes)-> where-> makeArray (s,t) = [(s ++ " array", ArrayTypeName t Nothing)-> ,(s ++ " array[5]", ArrayTypeName t (Just 5))]-> makeMultiset (s,t) = (s ++ " multiset", MultisetTypeName t)-> basicTypes =-> -- example of every standard type name-> map (\t -> (t,TypeName [Name Nothing t]))-> ["binary"-> ,"binary varying"-> ,"character"-> ,"char"-> ,"character varying"-> ,"char varying"-> ,"varbinary"-> ,"varchar"-> ,"character large object"-> ,"char large object"-> ,"clob"-> ,"national character"-> ,"national char"-> ,"nchar"-> ,"national character varying"-> ,"national char varying"-> ,"nchar varying"-> ,"national character large object"-> ,"nchar large object"-> ,"nclob"-> ,"binary large object"-> ,"blob"-> ,"numeric"-> ,"decimal"-> ,"dec"-> ,"smallint"-> ,"integer"-> ,"int"-> ,"bigint"-> ,"float"-> ,"real"-> ,"double precision"-> ,"boolean"-> ,"date"-> ,"time"-> ,"timestamp"]-> --interval -- not allowed without interval qualifier-> --row -- not allowed without row type body-> -- array -- not allowed on own-> -- multiset -- not allowed on own--> ++-> [-- 1 single prec + 1 with multiname-> ("char(5)", PrecTypeName [Name Nothing "char"] 5)-> ,("char varying(5)", PrecTypeName [Name Nothing "char varying"] 5)-> -- 1 scale-> ,("decimal(15,2)", PrecScaleTypeName [Name Nothing "decimal"] 15 2)-> ,("char(3 octets)"-> ,PrecLengthTypeName [Name Nothing "char"] 3 Nothing (Just PrecOctets))-> ,("varchar(50 characters)"-> ,PrecLengthTypeName [Name Nothing "varchar"] 50 Nothing (Just PrecCharacters))-> -- lob prec + with multiname-> ,("blob(3M)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecM) Nothing)-> ,("blob(3T)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecT) Nothing)-> ,("blob(3P)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecP) Nothing)-> ,("blob(4M characters) "-> ,PrecLengthTypeName [Name Nothing "blob"] 4 (Just PrecM) (Just PrecCharacters))-> ,("blob(6G octets) "-> ,PrecLengthTypeName [Name Nothing "blob"] 6 (Just PrecG) (Just PrecOctets))-> ,("national character large object(7K) "-> ,PrecLengthTypeName [Name Nothing "national character large object"]-> 7 (Just PrecK) Nothing)-> -- 1 with and without tz-> ,("time with time zone"-> ,TimeTypeName [Name Nothing "time"] Nothing True)-> ,("datetime(3) without time zone"-> ,TimeTypeName [Name Nothing "datetime"] (Just 3) False)-> -- chars: (single/multiname) x prec x charset x collate-> -- 1111-> ,("char varying(5) character set something collate something_insensitive"-> ,CharTypeName [Name Nothing "char varying"] (Just 5)-> [Name Nothing "something"] [Name Nothing "something_insensitive"])-> -- 0111-> ,("char(5) character set something collate something_insensitive"-> ,CharTypeName [Name Nothing "char"] (Just 5)-> [Name Nothing "something"] [Name Nothing "something_insensitive"])--> -- 1011-> ,("char varying character set something collate something_insensitive"-> ,CharTypeName [Name Nothing "char varying"] Nothing-> [Name Nothing "something"] [Name Nothing "something_insensitive"])-> -- 0011-> ,("char character set something collate something_insensitive"-> ,CharTypeName [Name Nothing "char"] Nothing-> [Name Nothing "something"] [Name Nothing "something_insensitive"])--> -- 1101-> ,("char varying(5) collate something_insensitive"-> ,CharTypeName [Name Nothing "char varying"] (Just 5)-> [] [Name Nothing "something_insensitive"])-> -- 0101-> ,("char(5) collate something_insensitive"-> ,CharTypeName [Name Nothing "char"] (Just 5)-> [] [Name Nothing "something_insensitive"])-> -- 1001-> ,("char varying collate something_insensitive"-> ,CharTypeName [Name Nothing "char varying"] Nothing-> [] [Name Nothing "something_insensitive"])-> -- 0001-> ,("char collate something_insensitive"-> ,CharTypeName [Name Nothing "char"] Nothing-> [] [Name Nothing "something_insensitive"])--> -- 1110-> ,("char varying(5) character set something"-> ,CharTypeName [Name Nothing "char varying"] (Just 5)-> [Name Nothing "something"] [])-> -- 0110-> ,("char(5) character set something"-> ,CharTypeName [Name Nothing "char"] (Just 5)-> [Name Nothing "something"] [])-> -- 1010-> ,("char varying character set something"-> ,CharTypeName [Name Nothing "char varying"] Nothing-> [Name Nothing "something"] [])-> -- 0010-> ,("char character set something"-> ,CharTypeName [Name Nothing "char"] Nothing-> [Name Nothing "something"] [])-> -- 1100-> ,("char varying character set something"-> ,CharTypeName [Name Nothing "char varying"] Nothing-> [Name Nothing "something"] [])--> -- single row field, two row field-> ,("row(a int)", RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])])-> ,("row(a int,b char)"-> ,RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])-> ,(Name Nothing "b", TypeName [Name Nothing "char"])])-> -- interval each type raw-> ,("interval year"-> ,IntervalTypeName (Itf "year" Nothing) Nothing)-> -- one type with single suffix-> -- one type with double suffix-> ,("interval year(2)"-> ,IntervalTypeName (Itf "year" $ Just (2,Nothing)) Nothing)-> ,("interval second(2,5)"-> ,IntervalTypeName (Itf "second" $ Just (2,Just 5)) Nothing)-> -- a to b with raw-> -- a to b with single suffix-> ,("interval year to month"-> ,IntervalTypeName (Itf "year" Nothing)-> (Just $ Itf "month" Nothing))-> ,("interval year(4) to second(2,3)"-> ,IntervalTypeName (Itf "year" $ Just (4,Nothing))-> (Just $ Itf "second" $ Just (2, Just 3)))-> ]--Now test each variation in both cast expression and typed literal-expression--> typeNameTests :: TestItem-> typeNameTests = Group "type names"-> [Group "type names" $ map (uncurry (TestScalarExpr ansi2011))-> $ concatMap makeSimpleTests $ fst typeNames-> ,Group "generated casts" $ map (uncurry (TestScalarExpr ansi2011))-> $ concatMap makeCastTests $ fst typeNames-> ,Group "generated typename" $ map (uncurry (TestScalarExpr ansi2011))-> $ concatMap makeTests $ snd typeNames]-> where-> makeSimpleTests (ctn, stn) =-> [(ctn ++ " 'test'", TypedLit stn "test")-> ]-> makeCastTests (ctn, stn) =-> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "'" "'" "test") stn)-> ]-> makeTests a = makeSimpleTests a ++ makeCastTests a---== 6.2 <field definition>--Function-Define a field of a row type.--<field definition> ::= <field name> <data type>--> fieldDefinition :: TestItem-> fieldDefinition = Group "field definition"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("cast('(1,2)' as row(a int,b char))"-> ,Cast (StringLit "'" "'" "(1,2)")-> $ RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])-> ,(Name Nothing "b", TypeName [Name Nothing "char"])])]--== 6.3 <value expression primary>--Function-Specify a value that is syntactically self-delimited.--<value expression primary> ::=- <parenthesized value expression>- | <nonparenthesized value expression primary>--<parenthesized value expression> ::=- <left paren> <value expression> <right paren>--<nonparenthesized value expression primary> ::=- <unsigned value specification>- | <column reference>- | <set function specification>- | <window function>- | <nested window function>- | <scalar subquery>- | <case expression>- | <cast specification>- | <field reference>- | <subtype treatment>- | <method invocation>- | <static method invocation>- | <new specification>- | <attribute or method reference>- | <reference resolution>- | <collection value constructor>- | <array element reference>- | <multiset element reference>- | <next value expression>- | <routine invocation>--<collection value constructor> ::=- <array value constructor>- | <multiset value constructor>--> valueExpressions :: TestItem-> valueExpressions = Group "value expressions"-> [generalValueSpecification-> ,parameterSpecification-> ,contextuallyTypedValueSpecification-> ,identifierChain-> ,columnReference-> ,setFunctionSpecification-> ,windowFunction-> ,nestedWindowFunction-> ,caseExpression-> ,castSpecification-> ,nextScalarExpression-> ,fieldReference-> ,arrayElementReference-> ,multisetElementReference-> ,numericScalarExpression-> ,numericValueFunction-> ,stringScalarExpression-> ,stringValueFunction-> ,datetimeScalarExpression-> ,datetimeValueFunction-> ,intervalScalarExpression-> ,intervalValueFunction-> ,booleanScalarExpression-> ,arrayScalarExpression-> ,arrayValueFunction-> ,arrayValueConstructor-> ,multisetScalarExpression-> ,multisetValueFunction-> ,multisetValueConstructor-> ,parenthesizedScalarExpression-> ]--> parenthesizedScalarExpression :: TestItem-> parenthesizedScalarExpression = Group "parenthesized value expression"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("(3)", Parens (NumLit "3"))-> ,("((3))", Parens $ Parens (NumLit "3"))-> ]--== 6.4 <value specification> and <target specification>--Function-Specify one or more values, host parameters, SQL parameters, dynamic parameters, or host variables.--<value specification> ::= <literal> | <general value specification>--<unsigned value specification> ::=- <unsigned literal>- | <general value specification>-- <general value specification> ::=- <host parameter specification>- | <SQL parameter reference>- | <dynamic parameter specification>- | <embedded variable specification>- | <current collation specification>- | CURRENT_CATALOG- | CURRENT_DEFAULT_TRANSFORM_GROUP- | CURRENT_PATH- | CURRENT_ROLE- | CURRENT_SCHEMA- | CURRENT_TRANSFORM_GROUP_FOR_TYPE <path-resolved user-defined type name>- | CURRENT_USER- | SESSION_USER- | SYSTEM_USER- | USER- | VALUE--> generalValueSpecification :: TestItem-> generalValueSpecification = Group "general value specification"-> $ map (uncurry (TestScalarExpr ansi2011)) $-> map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"-> ,"CURRENT_PATH"-> ,"CURRENT_ROLE"-> ,"CURRENT_USER"-> ,"SESSION_USER"-> ,"SYSTEM_USER"-> ,"USER"-> ,"VALUE"]-> where-> mkIden nm = (nm,Iden [Name Nothing nm])--TODO: add the missing bits--<simple value specification> ::=- <literal>- | <host parameter name>- | <SQL parameter reference>- | <embedded variable name>--<target specification> ::=- <host parameter specification>- | <SQL parameter reference>- | <column reference>- | <target array element specification>- | <dynamic parameter specification>- | <embedded variable specification>--<simple target specification> ::=- <host parameter name>- | <SQL parameter reference>- | <column reference>- | <embedded variable name>--<host parameter specification> ::=- <host parameter name> [ <indicator parameter> ]--<dynamic parameter specification> ::= <question mark>--<embedded variable specification> ::=- <embedded variable name> [ <indicator variable> ]--<indicator variable> ::= [ INDICATOR ] <embedded variable name>--<indicator parameter> ::= [ INDICATOR ] <host parameter name>--<target array element specification> ::=- <target array reference>- <left bracket or trigraph> <simple value specification> <right bracket or trigraph>--<target array reference> ::= <SQL parameter reference> | <column reference>--> parameterSpecification :: TestItem-> parameterSpecification = Group "parameter specification"-> $ map (uncurry (TestScalarExpr ansi2011))-> [(":hostparam", HostParameter ":hostparam" Nothing)-> ,(":hostparam indicator :another_host_param"-> ,HostParameter ":hostparam" $ Just ":another_host_param")-> ,("?", Parameter)-> ,(":h[3]", Array (HostParameter ":h" Nothing) [NumLit "3"])-> ]--<current collation specification> ::=- COLLATION FOR <left paren> <string value expression> <right paren>--TODO: review the modules stuff--== 6.5 <contextually typed value specification>--Function-Specify a value whose data type is to be inferred from its context.--<contextually typed value specification> ::=- <implicitly typed value specification>- | <default specification>--<implicitly typed value specification> ::=- <null specification>- | <empty specification>--<null specification> ::= NULL--<empty specification> ::=- ARRAY <left bracket or trigraph> <right bracket or trigraph>- | MULTISET <left bracket or trigraph> <right bracket or trigraph>--<default specification> ::= DEFAULT--> contextuallyTypedValueSpecification :: TestItem-> contextuallyTypedValueSpecification =-> Group "contextually typed value specification"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("null", Iden [Name Nothing "null"])-> ,("array[]", Array (Iden [Name Nothing "array"]) [])-> ,("multiset[]", MultisetCtor [])-> ,("default", Iden [Name Nothing "default"])-> ]--== 6.6 <identifier chain>--Function-Disambiguate a <period>-separated chain of identifiers.--<identifier chain> ::= <identifier> [ { <period> <identifier> }... ]--<basic identifier chain> ::= <identifier chain>--> identifierChain :: TestItem-> identifierChain = Group "identifier chain"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("a.b", Iden [Name Nothing "a",Name Nothing "b"])]--== 6.7 <column reference>--Function-Reference a column.--<column reference> ::=- <basic identifier chain>- | MODULE <period> <qualified identifier> <period> <column name>--> columnReference :: TestItem-> columnReference = Group "column reference"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("module.a.b", Iden [Name Nothing "module",Name Nothing "a",Name Nothing "b"])]--== 6.8 <SQL parameter reference>--Function-Reference an SQL parameter.--<SQL parameter reference> ::= <basic identifier chain>--== 6.9 <set function specification>--Function-Specify a value derived by the application of a function to an argument.--<set function specification> ::= <aggregate function> | <grouping operation>--<grouping operation> ::=- GROUPING <left paren> <column reference>- [ { <comma> <column reference> }... ] <right paren>--> setFunctionSpecification :: TestItem-> setFunctionSpecification = Group "set function specification"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\-> \ GROUPING(SalesQuota) AS Grouping\n\-> \FROM Sales.SalesPerson\n\-> \GROUP BY ROLLUP(SalesQuota);"-> ,makeSelect-> {qeSelectList = [(Iden [Name Nothing "SalesQuota"],Nothing)-> ,(App [Name Nothing "SUM"] [Iden [Name Nothing "SalesYTD"]]-> ,Just (Name Nothing "TotalSalesYTD"))-> ,(App [Name Nothing "GROUPING"] [Iden [Name Nothing "SalesQuota"]]-> ,Just (Name Nothing "Grouping"))]-> ,qeFrom = [TRSimple [Name Nothing "Sales",Name Nothing "SalesPerson"]]-> ,qeGroupBy = [Rollup [SimpleGroup (Iden [Name Nothing "SalesQuota"])]]})-> ]--== 6.10 <window function>--Function-Specify a window function.--<window function> ::=- <window function type> OVER <window name or specification>--<window function type> ::=- <rank function type> <left paren> <right paren>- | ROW_NUMBER <left paren> <right paren>- | <aggregate function>- | <ntile function>- | <lead or lag function>- | <first or last value function>- | <nth value function>--<rank function type> ::= RANK | DENSE_RANK | PERCENT_RANK | CUME_DIST--<ntile function> ::= NTILE <left paren> <number of tiles> <right paren>--<number of tiles> ::=- <simple value specification>- | <dynamic parameter specification>--<lead or lag function> ::=- <lead or lag> <left paren> <lead or lag extent>- [ <comma> <offset> [ <comma> <default expression> ] ] <right paren>- [ <null treatment> ]--<lead or lag> ::= LEAD | LAG--<lead or lag extent> ::= <value expression>--<offset> ::= <exact numeric literal>--<default expression> ::= <value expression>--<null treatment> ::= RESPECT NULLS | IGNORE NULLS--<first or last value function> ::=- <first or last value> <left paren> <value expression> <right paren> [ <null treatment>- ]--<first or last value> ::= FIRST_VALUE | LAST_VALUE--<nth value function> ::=- NTH_VALUE <left paren> <value expression> <comma> <nth row> <right paren>- [ <from first or last> ] [ <null treatment> ]--<nth row> ::= <simple value specification> | <dynamic parameter specification>--<from first or last> ::= FROM FIRST | FROM LAST--<window name or specification> ::=- <window name>- | <in-line window specification>--<in-line window specification> ::= <window specification>--> windowFunction :: TestItem-> windowFunction = Group "window function"-> [-- todo: window function-> ]--== 6.11 <nested window function>--Function--Specify a function nested in an aggregated argument of an-<aggregate function> simply contained in a <window function>.--<nested window function> ::=- <nested row number function>- | <value_of expression at row>--<nested row number function> ::=- ROW_NUMBER <left paren> <row marker> <right paren>--<value_of expression at row> ::=- VALUE_OF <left paren> <value expression> AT <row marker expression>- [ <comma> <value_of default value> ] <right paren>--<row marker> ::=- BEGIN_PARTITION- | BEGIN_FRAME- | CURRENT_ROW- | FRAME_ROW- | END_FRAME- | END_PARTITION--<row marker expression> ::= <row marker> [ <row marker delta> ]--<row marker delta> ::=- <plus sign> <row marker offset>- | <minus sign> <row marker offset>--<row marker offset> ::=- <simple value specification>- | <dynamic parameter specification>--<value_of default value> ::= <value expression>--> nestedWindowFunction :: TestItem-> nestedWindowFunction = Group "nested window function"-> [-- todo: nested window function-> ]---== 6.12 <case expression>--Function-Specify a conditional value.--<case expression> ::= <case abbreviation> | <case specification>--<case abbreviation> ::=- NULLIF <left paren> <value expression> <comma> <value expression> <right paren>- | COALESCE <left paren> <value expression>- { <comma> <value expression> }... <right paren>--<case specification> ::= <simple case> | <searched case>--<simple case> ::=- CASE <case operand> <simple when clause>... [ <else clause> ] END--<searched case> ::= CASE <searched when clause>... [ <else clause> ] END--<simple when clause> ::= WHEN <when operand list> THEN <result>--<searched when clause> ::= WHEN <search condition> THEN <result>--<else clause> ::= ELSE <result>--<case operand> ::= <row value predicand> | <overlaps predicate part 1>--<when operand list> ::= <when operand> [ { <comma> <when operand> }... ]--<when operand> ::=- <row value predicand>- | <comparison predicate part 2>- | <between predicate part 2>- | <in predicate part 2>- | <character like predicate part 2>- | <octet like predicate part 2>- | <similar predicate part 2>- | <regex like predicate part 2>- | <null predicate part 2>- | <quantified comparison predicate part 2>- | <normalized predicate part 2>- | <match predicate part 2>- | <overlaps predicate part 2>- | <distinct predicate part 2>- | <member predicate part 2>- | <submultiset predicate part 2>- | <set predicate part 2>- | <type predicate part 2>--I haven't seen these part 2 style when operands in the wild. It-doesn't even allow all the binary operators here. We will allow them-all, and parser and represent these expressions by considering all the-binary ops as unary prefix ops.--<result> ::= <result expression> | NULL--<result expression> ::= <value expression>--> caseExpression :: TestItem-> caseExpression = Group "case expression"-> [-- todo: case expression-> ]--== 6.13 <cast specification>--Function-Specify a data conversion.--<cast specification> ::=- CAST <left paren> <cast operand> AS <cast target> <right paren>--<cast operand> ::= <value expression> | <implicitly typed value specification>--<cast target> ::= <domain name> | <data type>--> castSpecification :: TestItem-> castSpecification = Group "cast specification"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("cast(a as int)"-> ,Cast (Iden [Name Nothing "a"]) (TypeName [Name Nothing "int"]))-> ]--== 6.14 <next value expression>--Function-Return the next value of a sequence generator.--<next value expression> ::= NEXT VALUE FOR <sequence generator name>--> nextScalarExpression :: TestItem-> nextScalarExpression = Group "next value expression"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("next value for a.b", NextValueFor [Name Nothing "a", Name Nothing "b"])-> ]--== 6.15 <field reference>--Function-Reference a field of a row value.--<field reference> ::= <value expression primary> <period> <field name>--> fieldReference :: TestItem-> fieldReference = Group "field reference"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("f(something).a"-> ,BinOp (App [Name Nothing "f"] [Iden [Name Nothing "something"]])-> [Name Nothing "."]-> (Iden [Name Nothing "a"]))-> ]--TODO: try all possible value expression syntax variations followed by-field reference--== 6.16 <subtype treatment>--Function-Modify the declared type of an expression.--<subtype treatment> ::=- TREAT <left paren> <subtype operand> AS <target subtype> <right paren>--<subtype operand> ::= <value expression>--<target subtype> ::= <path-resolved user-defined type name> | <reference type>--todo: subtype treatment--== 6.17 <method invocation>--Function-Reference an SQL-invoked method of a user-defined type value.--<method invocation> ::= <direct invocation> | <generalized invocation>--<direct invocation> ::=- <value expression primary> <period> <method name> [ <SQL argument list> ]--<generalized invocation> ::=- <left paren> <value expression primary> AS <data type> <right paren>- <period> <method name> [ <SQL argument list> ]--<method selection> ::= <routine invocation>--<constructor method selection> ::= <routine invocation>--todo: method invocation--== 6.18 <static method invocation>--Function-Invoke a static method.--<static method invocation> ::=- <path-resolved user-defined type name> <double colon> <method name>- [ <SQL argument list> ]--<static method selection> ::= <routine invocation>--todo: static method invocation--== 6.19 <new specification>--Function-Invoke a method on a newly-constructed value of a structured type.--<new specification> ::=- NEW <path-resolved user-defined type name> <SQL argument list>--<new invocation> ::= <method invocation> | <routine invocation>--todo: new specification--== 6.20 <attribute or method reference>--Function-Return a value acquired by accessing a column of the row identified by-a value of a reference type or by invoking an SQL-invoked method.--<attribute or method reference> ::=- <value expression primary> <dereference operator> <qualified identifier>- [ <SQL argument list> ]--<dereference operator> ::= <right arrow>--todo: attribute of method reference--== 6.21 <dereference operation>--Function-Access a column of the row identified by a value of a reference type.--<dereference operation> ::=- <reference value expression> <dereference operator> <attribute name>--todo: deference operation--== 6.22 <method reference>--Function-Return a value acquired from invoking an SQL-invoked routine that is a method.--<method reference> ::=- <value expression primary> <dereference operator> <method name> <SQL argument list>--todo: method reference--== 6.23 <reference resolution>--Function-Obtain the value referenced by a reference value.--<reference resolution> ::=- DEREF <left paren> <reference value expression> <right paren>--todo: reference resolution--== 6.24 <array element reference>--Function-Return an element of an array.--<array element reference> ::=- <array value expression>- <left bracket or trigraph> <numeric value expression> <right bracket or trigraph>--> arrayElementReference :: TestItem-> arrayElementReference = Group "array element reference"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("something[3]"-> ,Array (Iden [Name Nothing "something"]) [NumLit "3"])-> ,("(something(a))[x]"-> ,Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))-> [Iden [Name Nothing "x"]])-> ,("(something(a))[x][y] "-> ,Array (-> Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))-> [Iden [Name Nothing "x"]])-> [Iden [Name Nothing "y"]])-> ]--== 6.25 <multiset element reference>--Function-Return the sole element of a multiset of one element.--<multiset element reference> ::=- ELEMENT <left paren> <multiset value expression> <right paren>--> multisetElementReference :: TestItem-> multisetElementReference = Group "multisetElementReference"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("element(something)"-> ,App [Name Nothing "element"] [Iden [Name Nothing "something"]])-> ]--== 6.26 <value expression>--Function-Specify a value.--<value expression> ::=- <common value expression>- | <boolean value expression>- | <row value expression>--<common value expression> ::=- <numeric value expression>- | <string value expression>- | <datetime value expression>- | <interval value expression>- | <user-defined type value expression>- | <reference value expression>- | <collection value expression>--<user-defined type value expression> ::= <value expression primary>--<reference value expression> ::= <value expression primary>--<collection value expression> ::=- <array value expression>- | <multiset value expression>--== 6.27 <numeric value expression>--Function-Specify a numeric value.--<numeric value expression> ::=- <term>- | <numeric value expression> <plus sign> <term>- | <numeric value expression> <minus sign> <term>--<term> ::= <factor> | <term> <asterisk> <factor> | <term> <solidus> <factor>--<factor> ::= [ <sign> ] <numeric primary>--<numeric primary> ::= <value expression primary> | <numeric value function>--> numericScalarExpression :: TestItem-> numericScalarExpression = Group "numeric value expression"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("a + b", binOp "+")-> ,("a - b", binOp "-")-> ,("a * b", binOp "*")-> ,("a / b", binOp "/")-> ,("+a", prefOp "+")-> ,("-a", prefOp "-")-> ]-> where-> binOp o = BinOp (Iden [Name Nothing "a"]) [Name Nothing o] (Iden [Name Nothing "b"])-> prefOp o = PrefixOp [Name Nothing o] (Iden [Name Nothing "a"])--TODO: precedence and associativity tests (need to review all operators-for what precendence and associativity tests to write)--== 6.28 <numeric value function>--Function-Specify a function yielding a value of type numeric.--<numeric value function> ::=- <position expression>- | <regex occurrences function>- | <regex position expression>- | <extract expression>- | <length expression>- | <cardinality expression>- | <max cardinality expression>- | <absolute value expression>- | <modulus expression>- | <natural logarithm>- | <exponential function>- | <power function>- | <square root>- | <floor function>- | <ceiling function>- | <width bucket function>---> numericValueFunction :: TestItem-> numericValueFunction = Group "numeric value function"-> [-- todo: numeric value function-> ]--<position expression> ::=- <character position expression>- | <binary position expression>--<regex occurrences function> ::=- OCCURRENCES_REGEX <left paren>- <XQuery pattern> [ FLAG <XQuery option flag> ]- IN <regex subject string>- [ FROM <start position> ]- [ USING <char length units> ]- <right paren>--<XQuery pattern> ::= <character value expression>--<XQuery option flag> ::= <character value expression>--<regex subject string> ::= <character value expression>--<regex position expression> ::=- POSITION_REGEX <left paren>- [ <regex position start or after> ]- <XQuery pattern> [ FLAG <XQuery option flag> ]- IN <regex subject string>- [ FROM <start position> ]- [ USING <char length units> ]- [ OCCURRENCE <regex occurrence> ]- [ GROUP <regex capture group> ]- <right paren>--<regex position start or after> ::= START | AFTER--<regex occurrence> ::= <numeric value expression>--<regex capture group> ::= <numeric value expression>--<character position expression> ::=- POSITION <left paren> <character value expression 1> IN <character value expression 2>- [ USING <char length units> ] <right paren>--<character value expression 1> ::= <character value expression>--<character value expression 2> ::= <character value expression>--<binary position expression> ::=- POSITION <left paren> <binary value expression> IN <binary value expression> <right paren>--<length expression> ::= <char length expression> | <octet length expression>--<char length expression> ::=- { CHAR_LENGTH | CHARACTER_LENGTH } <left paren> <character value expression>- [ USING <char length units> ] <right paren>--<octet length expression> ::=- OCTET_LENGTH <left paren> <string value expression> <right paren>--<extract expression> ::=- EXTRACT <left paren> <extract field> FROM <extract source> <right paren>--<extract field> ::= <primary datetime field> | <time zone field>--<time zone field> ::= TIMEZONE_HOUR | TIMEZONE_MINUTE--<extract source> ::= <datetime value expression> | <interval value expression>--<cardinality expression> ::=- CARDINALITY <left paren> <collection value expression> <right paren>--<max cardinality expression> ::=- ARRAY_MAX_CARDINALITY <left paren> <array value expression> <right paren>--<absolute value expression> ::=- ABS <left paren> <numeric value expression> <right paren>--<modulus expression> ::=- MOD <left paren> <numeric value expression dividend> <comma>- <numeric value expression divisor> <right paren>--<numeric value expression dividend> ::= <numeric value expression>--<numeric value expression divisor> ::= <numeric value expression>--<natural logarithm> ::=- LN <left paren> <numeric value expression> <right paren>--<exponential function> ::=- EXP <left paren> <numeric value expression> <right paren>--<power function> ::=- POWER <left paren> <numeric value expression base> <comma>- <numeric value expression exponent> <right paren>--<numeric value expression base> ::= <numeric value expression>--<numeric value expression exponent> ::= <numeric value expression>--<square root> ::= SQRT <left paren> <numeric value expression> <right paren>--<floor function> ::=- FLOOR <left paren> <numeric value expression> <right paren>--<ceiling function> ::=- { CEIL | CEILING } <left paren> <numeric value expression> <right paren>--<width bucket function> ::=- WIDTH_BUCKET <left paren> <width bucket operand> <comma> <width bucket bound 1> <comma>- <width bucket bound 2> <comma> <width bucket count> <right paren>--<width bucket operand> ::= <numeric value expression>--<width bucket bound 1> ::= <numeric value expression>--<width bucket bound 2> ::= <numeric value expression>--<width bucket count> ::= <numeric value expression>--== 6.29 <string value expression>--Function-Specify a character string value or a binary string value.--<string value expression> ::=- <character value expression>- | <binary value expression>--<character value expression> ::= <concatenation> | <character factor>--<concatenation> ::=- <character value expression> <concatenation operator> <character factor>--<character factor> ::= <character primary> [ <collate clause> ]--<character primary> ::= <value expression primary> | <string value function>--<binary value expression> ::= <binary concatenation> | <binary factor>--<binary factor> ::= <binary primary>--<binary primary> ::= <value expression primary> | <string value function>--<binary concatenation> ::=- <binary value expression> <concatenation operator> <binary factor>--> stringScalarExpression :: TestItem-> stringScalarExpression = Group "string value expression"-> [-- todo: string value expression-> ]--== 6.30 <string value function>--Function-Specify a function yielding a value of type character string or binary string.--<string value function> ::=- <character value function>- | <binary value function>--<character value function> ::=- <character substring function>- | <regular expression substring function>- | <regex substring function>- | <fold>- | <transcoding>- | <character transliteration>- | <regex transliteration>- | <trim function>- | <character overlay function>- | <normalize function>- | <specific type method>--> stringValueFunction :: TestItem-> stringValueFunction = Group "string value function"-> [-- todo: string value function-> ]--<character substring function> ::=- SUBSTRING <left paren> <character value expression> FROM <start position>- [ FOR <string length> ] [ USING <char length units> ] <right paren>--<regular expression substring function> ::=- SUBSTRING <left paren> <character value expression> SIMILAR <character value expression>- ESCAPE <escape character> <right paren>--<regex substring function> ::=- SUBSTRING_REGEX <left paren>- <XQuery pattern> [ FLAG <XQuery option flag> ]- IN <regex subject string>- [ FROM <start position> ]- [ USING <char length units> ]- [ OCCURRENCE <regex occurrence> ]- [ GROUP <regex capture group> ]- <right paren>--<fold> ::=- { UPPER | LOWER } <left paren> <character value expression> <right paren>--<transcoding> ::=- CONVERT <left paren> <character value expression>- USING <transcoding name> <right paren>--<character transliteration> ::=- TRANSLATE <left paren> <character value expression>- USING <transliteration name> <right paren>--<regex transliteration> ::=- TRANSLATE_REGEX <left paren>- <XQuery pattern> [ FLAG <XQuery option flag> ]- IN <regex subject string>- [ WITH <XQuery replacement string> ]- [ FROM <start position> ]- [ USING <char length units> ]- [ OCCURRENCE <regex transliteration occurrence> ]- <right paren>--<XQuery replacement string> ::= <character value expression>--<regex transliteration occurrence> ::= <regex occurrence> | ALL--<trim function> ::= TRIM <left paren> <trim operands> <right paren>--<trim operands> ::=- [ [ <trim specification> ] [ <trim character> ] FROM ] <trim source>--<trim source> ::= <character value expression>--<trim specification> ::= LEADING | TRAILING | BOTH--<trim character> ::= <character value expression>--<character overlay function> ::=- OVERLAY <left paren> <character value expression> PLACING <character value expression>- FROM <start position> [ FOR <string length> ]- [ USING <char length units> ] <right paren>--<normalize function> ::=- NORMALIZE <left paren> <character value expression>- [ <comma> <normal form> [ <comma> <normalize function result length> ] ] <right paren>--<normal form> ::= NFC | NFD | NFKC | NFKD--<normalize function result length> ::=- <character length>- | <character large object length>--<specific type method> ::=- <user-defined type value expression> <period> SPECIFICTYPE- [ <left paren> <right paren> ]--<binary value function> ::=- <binary substring function>- | <binary trim function>- | <binary overlay function>--<binary substring function> ::=- SUBSTRING <left paren> <binary value expression> FROM <start position>- [ FOR <string length> ] <right paren>--<binary trim function> ::=- TRIM <left paren> <binary trim operands> <right paren>--<binary trim operands> ::=- [ [ <trim specification> ] [ <trim octet> ] FROM ] <binary trim source>--<binary trim source> ::= <binary value expression>--<trim octet> ::= <binary value expression>--<binary overlay function> ::=- OVERLAY <left paren> <binary value expression> PLACING <binary value expression>- FROM <start position> [ FOR <string length> ] <right paren>--<start position> ::= <numeric value expression>--<string length> ::= <numeric value expression>--== 6.31 <datetime value expression>--Function-Specify a datetime value.--<datetime value expression> ::=- <datetime term>- | <interval value expression> <plus sign> <datetime term>- | <datetime value expression> <plus sign> <interval term>- | <datetime value expression> <minus sign> <interval term>--> datetimeScalarExpression :: TestItem-> datetimeScalarExpression = Group "datetime value expression"-> [-- todo: datetime value expression-> datetimeValueFunction -> ]--<datetime term> ::= <datetime factor>--<datetime factor> ::= <datetime primary> [ <time zone> ]--<datetime primary> ::= <value expression primary> | <datetime value function>--<time zone> ::= AT <time zone specifier>--<time zone specifier> ::= LOCAL | TIME ZONE <interval primary>--== 6.32 <datetime value function>--Function-Specify a function yielding a value of type datetime.--<datetime value function> ::=- <current date value function>- | <current time value function>- | <current timestamp value function>- | <current local time value function>- | <current local timestamp value function>--> datetimeValueFunction :: TestItem-> datetimeValueFunction = Group "datetime value function"-> [-- todo: datetime value function-> ]--<current date value function> ::= CURRENT_DATE--<current time value function> ::=- CURRENT_TIME [ <left paren> <time precision> <right paren> ]--<current local time value function> ::=- LOCALTIME [ <left paren> <time precision> <right paren> ]--<current timestamp value function> ::=- CURRENT_TIMESTAMP [ <left paren> <timestamp precision> <right paren> ]--<current local timestamp value function> ::=- LOCALTIMESTAMP [ <left paren> <timestamp precision> <right paren> ]--== 6.33 <interval value expression>--Function-Specify an interval value.--<interval value expression> ::=- <interval term>- | <interval value expression 1> <plus sign> <interval term 1>- | <interval value expression 1> <minus sign> <interval term 1>- | <left paren> <datetime value expression> <minus sign> <datetime term> <right paren>- <interval qualifier>--> intervalScalarExpression :: TestItem-> intervalScalarExpression = Group "interval value expression"-> [-- todo: interval value expression-> ]---<interval term> ::=- <interval factor>- | <interval term 2> <asterisk> <factor>- | <interval term 2> <solidus> <factor>- | <term> <asterisk> <interval factor>--<interval factor> ::= [ <sign> ] <interval primary>--<interval primary> ::=- <value expression primary> [ <interval qualifier> ]- | <interval value function>--<interval value expression 1> ::= <interval value expression>--<interval term 1> ::= <interval term>--<interval term 2> ::= <interval term>--== 6.34 <interval value function>--Function-Specify a function yielding a value of type interval.--<interval value function> ::= <interval absolute value function>--<interval absolute value function> ::=- ABS <left paren> <interval value expression> <right paren>--> intervalValueFunction :: TestItem-> intervalValueFunction = Group "interval value function"-> [-- todo: interval value function-> ]---== 6.35 <boolean value expression>--Function-Specify a boolean value.--<boolean value expression> ::=- <boolean term>- | <boolean value expression> OR <boolean term>--<boolean term> ::= <boolean factor> | <boolean term> AND <boolean factor>--<boolean factor> ::= [ NOT ] <boolean test>--<boolean test> ::= <boolean primary> [ IS [ NOT ] <truth value> ]--<truth value> ::= TRUE | FALSE | UNKNOWN--<boolean primary> ::= <predicate> | <boolean predicand>--<boolean predicand> ::=- <parenthesized boolean value expression>- | <nonparenthesized value expression primary>--<parenthesized boolean value expression> ::=- <left paren> <boolean value expression> <right paren>---> booleanScalarExpression :: TestItem-> booleanScalarExpression = Group "booleab value expression"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("a or b", BinOp a [Name Nothing "or"] b)-> ,("a and b", BinOp a [Name Nothing "and"] b)-> ,("not a", PrefixOp [Name Nothing "not"] a)-> ,("a is true", postfixOp "is true")-> ,("a is false", postfixOp "is false")-> ,("a is unknown", postfixOp "is unknown")-> ,("a is not true", postfixOp "is not true")-> ,("a is not false", postfixOp "is not false")-> ,("a is not unknown", postfixOp "is not unknown")-> ,("(a or b)", Parens $ BinOp a [Name Nothing "or"] b)-> ]-> where-> a = Iden [Name Nothing "a"]-> b = Iden [Name Nothing "b"]-> postfixOp nm = PostfixOp [Name Nothing nm] a--TODO: review if more tests are needed. Should at least have-precendence tests for mixed and, or and not without parens.--== 6.36 <array value expression>--Function-Specify an array value.--<array value expression> ::= <array concatenation> | <array primary>--<array concatenation> ::=- <array value expression 1> <concatenation operator> <array primary>--<array value expression 1> ::= <array value expression>--<array primary> ::= <array value function> | <value expression primary>--> arrayScalarExpression :: TestItem-> arrayScalarExpression = Group "array value expression"-> [-- todo: array value expression-> ]--== 6.37 <array value function>--Function-Specify a function yielding a value of an array type.--<array value function> ::= <trim array function>--<trim array function> ::=- TRIM_ARRAY <left paren> <array value expression> <comma> <numeric value expression>- <right paren>--> arrayValueFunction :: TestItem-> arrayValueFunction = Group "array value function"-> [-- todo: array value function-> ]--== 6.38 <array value constructor>--Function-Specify construction of an array.--<array value constructor> ::=- <array value constructor by enumeration>- | <array value constructor by query>--<array value constructor by enumeration> ::=- ARRAY <left bracket or trigraph> <array element list> <right bracket or trigraph>--<array element list> ::= <array element> [ { <comma> <array element> }... ]--<array element> ::= <value expression>--<array value constructor by query> ::= ARRAY <table subquery>--> arrayValueConstructor :: TestItem-> arrayValueConstructor = Group "array value constructor"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("array[1,2,3]"-> ,Array (Iden [Name Nothing "array"])-> [NumLit "1", NumLit "2", NumLit "3"])-> ,("array[a,b,c]"-> ,Array (Iden [Name Nothing "array"])-> [Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]])-> ,("array(select * from t)"-> ,ArrayCtor (makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}))-> ,("array(select * from t order by a)"-> ,ArrayCtor (makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeOrderBy = [SortSpec (Iden [Name Nothing "a"])-> DirDefault NullsOrderDefault]}))-> ]---== 6.39 <multiset value expression>--Function-Specify a multiset value.--<multiset value expression> ::=- <multiset term>- | <multiset value expression> MULTISET UNION [ ALL | DISTINCT ] <multiset term>- | <multiset value expression> MULTISET EXCEPT [ ALL | DISTINCT ] <multiset term>--<multiset term> ::=- <multiset primary>- | <multiset term> MULTISET INTERSECT [ ALL | DISTINCT ] <multiset primary>--<multiset primary> ::= <multiset value function> | <value expression primary>--> multisetScalarExpression :: TestItem-> multisetScalarExpression = Group "multiset value expression"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("a multiset union b"-> ,MultisetBinOp (Iden [Name Nothing "a"]) Union SQDefault (Iden [Name Nothing "b"]))-> ,("a multiset union all b"-> ,MultisetBinOp (Iden [Name Nothing "a"]) Union All (Iden [Name Nothing "b"]))-> ,("a multiset union distinct b"-> ,MultisetBinOp (Iden [Name Nothing "a"]) Union Distinct (Iden [Name Nothing "b"]))-> ,("a multiset except b"-> ,MultisetBinOp (Iden [Name Nothing "a"]) Except SQDefault (Iden [Name Nothing "b"]))-> ,("a multiset intersect b"-> ,MultisetBinOp (Iden [Name Nothing "a"]) Intersect SQDefault (Iden [Name Nothing "b"]))-> ]--TODO: check precedence and associativity--== 6.40 <multiset value function>--Function-Specify a function yielding a value of a multiset type.--<multiset value function> ::= <multiset set function>--<multiset set function> ::=- SET <left paren> <multiset value expression> <right paren>--TODO: set is now a reserved keyword. Fix the set parsing with a-special case term.--> multisetValueFunction :: TestItem-> multisetValueFunction = Group "multiset value function"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("set(a)", App [Name Nothing "set"] [Iden [Name Nothing "a"]])-> ]--== 6.41 <multiset value constructor>--Function-Specify construction of a multiset.--<multiset value constructor> ::=- <multiset value constructor by enumeration>- | <multiset value constructor by query>- | <table value constructor by query>--<multiset value constructor by enumeration> ::=- MULTISET <left bracket or trigraph> <multiset element list> <right bracket or trigraph>--<multiset element list> ::=- <multiset element> [ { <comma> <multiset element> }... ]--<multiset element> ::= <value expression>--<multiset value constructor by query> ::= MULTISET <table subquery>--<table value constructor by query> ::= TABLE <table subquery>--> multisetValueConstructor :: TestItem-> multisetValueConstructor = Group "multiset value constructor"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("multiset[a,b,c]", MultisetCtor[Iden [Name Nothing "a"]-> ,Iden [Name Nothing "b"], Iden [Name Nothing "c"]])-> ,("multiset(select * from t)", MultisetQueryCtor qe)-> ,("table(select * from t)", MultisetQueryCtor qe)-> ]-> where-> qe = makeSelect {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}---= 7 Query expressions--> queryExpressions :: TestItem-> queryExpressions = Group "query expressions"-> [rowValueConstructor-> ,tableValueConstructor-> ,fromClause-> ,tableReference-> ,joinedTable-> ,whereClause-> ,groupByClause-> ,havingClause-> ,windowClause-> ,querySpecification-> ,withQueryExpression-> ,setOpQueryExpression-> ,explicitTableQueryExpression-> ,orderOffsetFetchQueryExpression-> ,searchOrCycleClause-> ]---== 7.1 <row value constructor>--Function-Specify a value or list of values to be constructed into a row.--<row value constructor> ::=- <common value expression>- | <boolean value expression>- | <explicit row value constructor>--<explicit row value constructor> ::=- <left paren> <row value constructor element> <comma>- <row value constructor element list> <right paren>- | ROW <left paren> <row value constructor element list> <right paren>- | <row subquery>--<row value constructor element list> ::=- <row value constructor element> [ { <comma> <row value constructor element> }... ]--<row value constructor element> ::= <value expression>--<contextually typed row value constructor> ::=- <common value expression>- | <boolean value expression>- | <contextually typed value specification>- | <left paren> <contextually typed value specification> <right paren>- | <left paren> <contextually typed row value constructor element> <comma>- <contextually typed row value constructor element list> <right paren>- | ROW <left paren> <contextually typed row value constructor element list> <right paren>--<contextually typed row value constructor element list> ::=- <contextually typed row value constructor element>- [ { <comma> <contextually typed row value constructor element> }... ]--<contextually typed row value constructor element> ::=- <value expression>- | <contextually typed value specification>--<row value constructor predicand> ::=- <common value expression>- | <boolean predicand>- | <explicit row value constructor>--> rowValueConstructor :: TestItem-> rowValueConstructor = Group "row value constructor"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("(a,b)"-> ,SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])-> ,("row(1)",App [Name Nothing "row"] [NumLit "1"])-> ,("row(1,2)",App [Name Nothing "row"] [NumLit "1",NumLit "2"])-> ]--== 7.2 <row value expression>--Function-Specify a row value.--<row value expression> ::=- <row value special case>- | <explicit row value constructor>--<table row value expression> ::=- <row value special case>- | <row value constructor>--<contextually typed row value expression> ::=- <row value special case>- | <contextually typed row value constructor>--<row value predicand> ::=- <row value special case>- | <row value constructor predicand>--<row value special case> ::= <nonparenthesized value expression primary>--There is nothing new here.--== 7.3 <table value constructor>--Function-Specify a set of <row value expression>s to be constructed into a table.--<table value constructor> ::= VALUES <row value expression list>--<row value expression list> ::=- <table row value expression> [ { <comma> <table row value expression> }... ]--<contextually typed table value constructor> ::=- VALUES <contextually typed row value expression list>--<contextually typed row value expression list> ::=- <contextually typed row value expression>- [ { <comma> <contextually typed row value expression> }... ]--> tableValueConstructor :: TestItem-> tableValueConstructor = Group "table value constructor"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("values (1,2), (a+b,(select count(*) from t));"-> ,Values [[NumLit "1", NumLit "2"]-> ,[BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]-> (Iden [Name Nothing "b"])-> ,SubQueryExpr SqSq-> (makeSelect-> {qeSelectList = [(App [Name Nothing "count"] [Star],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]})]])-> ]--== 7.4 <table expression>--Function-Specify a table or a grouped table.--<table expression> ::=- <from clause>- [ <where clause> ]- [ <group by clause> ]- [ <having clause> ]- [ <window clause> ]--== 7.5 <from clause>--Function-Specify a table derived from one or more tables.--<from clause> ::= FROM <table reference list>--<table reference list> ::=- <table reference> [ { <comma> <table reference> }... ]--> fromClause :: TestItem-> fromClause = Group "fromClause"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select * from tbl1,tbl2"-> ,makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "tbl1"], TRSimple [Name Nothing "tbl2"]]-> })]---== 7.6 <table reference>--Function-Reference a table.--> tableReference :: TestItem-> tableReference = Group "table reference"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select * from t", sel)--<table reference> ::= <table factor> | <joined table>--<table factor> ::= <table primary> [ <sample clause> ]--<sample clause> ::=- TABLESAMPLE <sample method> <left paren> <sample percentage> <right paren>- [ <repeatable clause> ]--<sample method> ::= BERNOULLI | SYSTEM--<repeatable clause> ::= REPEATABLE <left paren> <repeat argument> <right paren>--<sample percentage> ::= <numeric value expression>--<repeat argument> ::= <numeric value expression>--<table primary> ::=- <table or query name> [ <query system time period specification> ]- [ [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ] ]- | <derived table> [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ]- | <lateral derived table> [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ]- | <collection derived table> [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ]- | <table function derived table> [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ]- | <only spec> [ [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ] ]- | <data change delta table> [ [ AS ] <correlation name>- [ <left paren> <derived column list> <right paren> ] ]- | <parenthesized joined table>--<query system time period specification> ::=- FOR SYSTEM_TIME AS OF <point in time 1>- | FOR SYSTEM_TIME BETWEEN [ ASYMMETRIC | SYMMETRIC ]- <point in time 1> AND <point in time 2>- | FOR SYSTEM_TIME FROM <point in time 1> TO <point in time 2>--TODO: query system time period spec--<point in time 1> ::= <point in time>--<point in time 2> ::= <point in time>--<point in time> ::= <datetime value expression>--<only spec> ::= ONLY <left paren> <table or query name> <right paren>--TODO: only--<lateral derived table> ::= LATERAL <table subquery>--<collection derived table> ::=- UNNEST <left paren> <collection value expression>- [ { <comma> <collection value expression> }... ] <right paren>- [ WITH ORDINALITY ]--<table function derived table> ::=- TABLE <left paren> <collection value expression> <right paren>--<derived table> ::= <table subquery>--<table or query name> ::= <table name> | <transition table name> | <query name>--<derived column list> ::= <column name list>--<column name list> ::= <column name> [ { <comma> <column name> }... ]--<data change delta table> ::=- <result option> TABLE <left paren> <data change statement> <right paren>--<data change statement> ::=- <delete statement: searched>- | <insert statement>- | <merge statement>- | <update statement: searched>--<result option> ::= FINAL | NEW | OLD--<parenthesized joined table> ::=- <left paren> <parenthesized joined table> <right paren>- | <left paren> <joined table> <right paren>---> -- table or query name-> ,("select * from t u", a sel)-> ,("select * from t as u", a sel)-> ,("select * from t u(a,b)", sel1 )-> ,("select * from t as u(a,b)", sel1)-> -- derived table TODO: realistic example-> ,("select * from (select * from t) u"-> ,a $ sel {qeFrom = [TRQueryExpr sel]})-> -- lateral TODO: realistic example-> ,("select * from lateral t"-> ,af TRLateral sel)-> -- TODO: bug, lateral should bind more tightly than the alias-> --,("select * from lateral t u"-> -- ,a $ af sel TRLateral)-> -- collection TODO: realistic example-> -- TODO: make it work-> --,("select * from unnest(a)", undefined)-> --,("select * from unnest(a,b)", undefined)-> --,("select * from unnest(a,b) with ordinality", undefined)-> --,("select * from unnest(a,b) with ordinality u", undefined)-> --,("select * from unnest(a,b) with ordinality as u", undefined)-> -- table fn TODO: realistic example-> -- TODO: make it work-> --,("select * from table(a)", undefined)-> -- parens-> ,("select * from (a join b)", jsel)-> ,("select * from (a join b) u", a jsel)-> ,("select * from ((a join b)) u", a $ af TRParens jsel)-> ,("select * from ((a join b) u) u", a $ af TRParens $ a jsel)-> ]-> where-> sel = makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}-> af f s = s {qeFrom = map f (qeFrom s)}-> a s = af (\x -> TRAlias x $ Alias (Name Nothing "u") Nothing) s-> sel1 = makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRAlias (TRSimple [Name Nothing "t"])-> $ Alias (Name Nothing "u") $ Just [Name Nothing "a", Name Nothing "b"]]}-> jsel = sel {qeFrom =-> [TRParens $ TRJoin (TRSimple [Name Nothing "a"])-> False-> JInner-> (TRSimple [Name Nothing "b"])-> Nothing]}--== 7.7 <joined table>--Function-Specify a table derived from a Cartesian product, inner join, or outer join.--<joined table> ::= <cross join> | <qualified join> | <natural join>--<cross join> ::= <table reference> CROSS JOIN <table factor>--<qualified join> ::=- { <table reference> | <partitioned join table> }- [ <join type> ] JOIN- { <table reference> | <partitioned join table> }- <join specification>--<partitioned join table> ::=- <table factor> PARTITION BY- <partitioned join column reference list>--<partitioned join column reference list> ::=- <left paren> <partitioned join column reference>- [ { <comma> <partitioned join column reference> }... ]- <right paren>--<partitioned join column reference> ::= <column reference>--<natural join> ::=- { <table reference> | <partitioned join table> }- NATURAL [ <join type> ] JOIN- { <table factor> | <partitioned join table> }--<join specification> ::= <join condition> | <named columns join>--<join condition> ::= ON <search condition>--<named columns join> ::= USING <left paren> <join column list> <right paren>--<join type> ::= INNER | <outer join type> [ OUTER ]--<outer join type> ::= LEFT | RIGHT | FULL--<join column list> ::= <column name list>--> joinedTable :: TestItem-> joinedTable = Group "joined table"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select * from a cross join b"-> ,sel $ TRJoin a False JCross b Nothing)-> ,("select * from a join b on true"-> ,sel $ TRJoin a False JInner b-> (Just $ JoinOn $ Iden [Name Nothing "true"]))-> ,("select * from a join b using (c)"-> ,sel $ TRJoin a False JInner b-> (Just $ JoinUsing [Name Nothing "c"]))-> ,("select * from a inner join b on true"-> ,sel $ TRJoin a False JInner b-> (Just $ JoinOn $ Iden [Name Nothing "true"]))-> ,("select * from a left join b on true"-> ,sel $ TRJoin a False JLeft b-> (Just $ JoinOn $ Iden [Name Nothing "true"]))-> ,("select * from a left outer join b on true"-> ,sel $ TRJoin a False JLeft b-> (Just $ JoinOn $ Iden [Name Nothing "true"]))-> ,("select * from a right join b on true"-> ,sel $ TRJoin a False JRight b-> (Just $ JoinOn $ Iden [Name Nothing "true"]))-> ,("select * from a full join b on true"-> ,sel $ TRJoin a False JFull b-> (Just $ JoinOn $ Iden [Name Nothing "true"]))-> ,("select * from a natural join b"-> ,sel $ TRJoin a True JInner b Nothing)-> ,("select * from a natural inner join b"-> ,sel $ TRJoin a True JInner b Nothing)-> ,("select * from a natural left join b"-> ,sel $ TRJoin a True JLeft b Nothing)-> ,("select * from a natural left outer join b"-> ,sel $ TRJoin a True JLeft b Nothing)-> ,("select * from a natural right join b"-> ,sel $ TRJoin a True JRight b Nothing)-> ,("select * from a natural full join b"-> ,sel $ TRJoin a True JFull b Nothing)-> ]-> where-> sel t = makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [t]}-> a = TRSimple [Name Nothing "a"]-> b = TRSimple [Name Nothing "b"]--TODO: partitioned joins--== 7.8 <where clause>--Function--Specify a table derived by the application of a <search condition> to-the result of the preceding <from clause>.--<where clause> ::= WHERE <search condition>--> whereClause :: TestItem-> whereClause = Group "where clause"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select * from t where a = 5"-> ,makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})]--== 7.9 <group by clause>--Function--Specify a grouped table derived by the application of the <group by-clause> to the result of the previously specified clause.--<group by clause> ::= GROUP BY [ <set quantifier> ] <grouping element list>--<grouping element list> ::=- <grouping element> [ { <comma> <grouping element> }... ]--<grouping element> ::=- <ordinary grouping set>- | <rollup list>- | <cube list>- | <grouping sets specification>- | <empty grouping set>--<ordinary grouping set> ::=- <grouping column reference>- | <left paren> <grouping column reference list> <right paren>--<grouping column reference> ::= <column reference> [ <collate clause> ]--<grouping column reference list> ::=- <grouping column reference> [ { <comma> <grouping column reference> }... ]--<rollup list> ::=- ROLLUP <left paren> <ordinary grouping set list> <right paren>--<ordinary grouping set list> ::=- <ordinary grouping set> [ { <comma> <ordinary grouping set> }... ]--<cube list> ::= CUBE <left paren> <ordinary grouping set list> <right paren>--<grouping sets specification> ::=- GROUPING SETS <left paren> <grouping set list> <right paren>--<grouping set list> ::= <grouping set> [ { <comma> <grouping set> }... ]--<grouping set> ::=- <ordinary grouping set>- | <rollup list>- | <cube list>- | <grouping sets specification>- | <empty grouping set>--<empty grouping set> ::= <left paren> <right paren>---> groupByClause :: TestItem-> groupByClause = Group "group by clause"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select a,sum(x) from t group by a"-> ,qe [SimpleGroup $ Iden [Name Nothing "a"]])-> ,("select a,sum(x) from t group by a collate c"-> ,qe [SimpleGroup $ Collate (Iden [Name Nothing "a"]) [Name Nothing "c"]])-> ,("select a,b,sum(x) from t group by a,b"-> ,qex [SimpleGroup $ Iden [Name Nothing "a"]-> ,SimpleGroup $ Iden [Name Nothing "b"]])-> -- todo: group by set quantifier-> --,("select a,sum(x) from t group by distinct a"-> --,undefined)-> --,("select a,sum(x) from t group by all a"-> -- ,undefined)-> ,("select a,b,sum(x) from t group by rollup(a,b)"-> ,qex [Rollup [SimpleGroup $ Iden [Name Nothing "a"]-> ,SimpleGroup $ Iden [Name Nothing "b"]]])-> ,("select a,b,sum(x) from t group by cube(a,b)"-> ,qex [Cube [SimpleGroup $ Iden [Name Nothing "a"]-> ,SimpleGroup $ Iden [Name Nothing "b"]]])-> ,("select a,b,sum(x) from t group by grouping sets((),(a,b))"-> ,qex [GroupingSets [GroupingParens []-> ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]-> ,SimpleGroup $ Iden [Name Nothing "b"]]]])-> ,("select sum(x) from t group by ()"-> ,let x = qe [GroupingParens []]-> in x {qeSelectList = tail $ qeSelectList x})-> ]-> where-> qe g = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)-> ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeGroupBy = g}-> qex g = let x = qe g-> in x {qeSelectList = let [a,b] = qeSelectList x-> in [a,(Iden [Name Nothing "b"],Nothing),b]}--== 7.10 <having clause>--Function--Specify a grouped table derived by the elimination of groups that do-not satisfy a <search condition>.--<having clause> ::= HAVING <search condition>--> havingClause :: TestItem-> havingClause = Group "having clause"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select a,sum(x) from t group by a having sum(x) > 1000"-> ,makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)-> ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]-> ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "x"]])-> [Name Nothing ">"]-> (NumLit "1000")})-> ]--== 7.11 <window clause>--Function-Specify one or more window definitions.--<window clause> ::= WINDOW <window definition list>--<window definition list> ::=- <window definition> [ { <comma> <window definition> }... ]--<window definition> ::= <new window name> AS <window specification>--<new window name> ::= <window name>--<window specification> ::=- <left paren> <window specification details> <right paren>--<window specification details> ::=- [ <existing window name> ]- [ <window partition clause> ]- [ <window order clause> ]- [ <window frame clause> ]--<existing window name> ::= <window name>--<window partition clause> ::=- PARTITION BY <window partition column reference list>--<window partition column reference list> ::=- <window partition column reference>- [ { <comma> <window partition column reference> }... ]--<window partition column reference> ::= <column reference> [ <collate clause> ]--<window order clause> ::= ORDER BY <sort specification list>--<window frame clause> ::=- <window frame units> <window frame extent>- [ <window frame exclusion> ]--<window frame units> ::= ROWS | RANGE | GROUPS--<window frame extent> ::= <window frame start> | <window frame between>--<window frame start> ::=- UNBOUNDED PRECEDING- | <window frame preceding>- | CURRENT ROW--<window frame preceding> ::= <unsigned value specification> PRECEDING--<window frame between> ::=- BETWEEN <window frame bound 1> AND <window frame bound 2>--<window frame bound 1> ::= <window frame bound>--<window frame bound 2> ::= <window frame bound>--<window frame bound> ::=- <window frame start>- | UNBOUNDED FOLLOWING- | <window frame following>--<window frame following> ::= <unsigned value specification> FOLLOWING--<window frame exclusion> ::=- EXCLUDE CURRENT ROW- | EXCLUDE GROUP- | EXCLUDE TIES- | EXCLUDE NO OTHERS--> windowClause :: TestItem-> windowClause = Group "window clause"-> [-- todo: window clause-> ]--== 7.12 <query specification>--Function-Specify a table derived from the result of a <table expression>.--<query specification> ::=- SELECT [ <set quantifier> ] <select list> <table expression>--<select list> ::=- <asterisk>- | <select sublist> [ { <comma> <select sublist> }... ]--<select sublist> ::= <derived column> | <qualified asterisk>--<qualified asterisk> ::=- <asterisked identifier chain> <period> <asterisk>- | <all fields reference>--<asterisked identifier chain> ::=- <asterisked identifier> [ { <period> <asterisked identifier> }... ]--<asterisked identifier> ::= <identifier>--<derived column> ::= <value expression> [ <as clause> ]--<as clause> ::= [ AS ] <column name>--<all fields reference> ::=- <value expression primary> <period> <asterisk>- [ AS <left paren> <all fields column name list> <right paren> ]--<all fields column name list> ::= <column name list>--> querySpecification :: TestItem-> querySpecification = Group "query specification"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select a from t",qe)-> ,("select all a from t",qe {qeSetQuantifier = All})-> ,("select distinct a from t",qe {qeSetQuantifier = Distinct})-> ,("select * from t", qe {qeSelectList = [(Star,Nothing)]})-> ,("select a.* from t"-> ,qe {qeSelectList = [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "."] Star-> ,Nothing)]})-> ,("select a b from t"-> ,qe {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]})-> ,("select a as b from t"-> ,qe {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]})-> ,("select a,b from t"-> ,qe {qeSelectList = [(Iden [Name Nothing "a"], Nothing)-> ,(Iden [Name Nothing "b"], Nothing)]})-> -- todo: all field reference alias-> --,("select * as (a,b) from t",undefined)-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }--== 7.13 <query expression>--Function-Specify a table.--<query expression> ::=- [ <with clause> ] <query expression body>- [ <order by clause> ] [ <result offset clause> ] [ <fetch first clause> ]--<with clause> ::= WITH [ RECURSIVE ] <with list>--<with list> ::= <with list element> [ { <comma> <with list element> }... ]--<with list element> ::=- <query name> [ <left paren> <with column list> <right paren> ]- AS <table subquery> [ <search or cycle clause> ]--<with column list> ::= <column name list>--> withQueryExpression :: TestItem-> withQueryExpression= Group "with query expression"-> [-- todo: with query expression-> ]--<query expression body> ::=- <query term>- | <query expression body> UNION [ ALL | DISTINCT ]- [ <corresponding spec> ] <query term>- | <query expression body> EXCEPT [ ALL | DISTINCT ]- [ <corresponding spec> ] <query term>--<query term> ::=- <query primary>- | <query term> INTERSECT [ ALL | DISTINCT ]- [ <corresponding spec> ] <query primary>--<query primary> ::=- <simple table>- | <left paren> <query expression body>- [ <order by clause> ] [ <result offset clause> ] [ <fetch first clause> ]- <right paren>--> setOpQueryExpression :: TestItem-> setOpQueryExpression= Group "set operation query expression"-> $ map (uncurry (TestQueryExpr ansi2011))-> -- todo: complete setop query expression tests-> [{-("select * from t union select * from t"-> ,undefined)-> ,("select * from t union all select * from t"-> ,undefined)-> ,("select * from t union distinct select * from t"-> ,undefined)-> ,("select * from t union corresponding select * from t"-> ,undefined)-> ,("select * from t union corresponding by (a,b) select * from t"-> ,undefined)-> ,("select * from t except select * from t"-> ,undefined)-> ,("select * from t in intersect select * from t"-> ,undefined)-}-> ]--TODO: tests for the associativity and precendence--TODO: not sure exactly where parens are allowed, we will allow them-everywhere--<simple table> ::=- <query specification>- | <table value constructor>- | <explicit table>--<explicit table> ::= TABLE <table or query name>--<corresponding spec> ::=- CORRESPONDING [ BY <left paren> <corresponding column list> <right paren> ]--<corresponding column list> ::= <column name list>--> explicitTableQueryExpression :: TestItem-> explicitTableQueryExpression= Group "explicit table query expression"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("table t", Table [Name Nothing "t"])-> ]---<order by clause> ::= ORDER BY <sort specification list>--<result offset clause> ::= OFFSET <offset row count> { ROW | ROWS }--<fetch first clause> ::=- FETCH { FIRST | NEXT } [ <fetch first quantity> ] { ROW | ROWS } { ONLY | WITH TIES }--<fetch first quantity> ::= <fetch first row count> | <fetch first percentage>--<offset row count> ::= <simple value specification>--<fetch first row count> ::= <simple value specification>--<fetch first percentage> ::= <simple value specification> PERCENT--> orderOffsetFetchQueryExpression :: TestItem-> orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"-> $ map (uncurry (TestQueryExpr ansi2011))-> [-- todo: finish tests for order offset and fetch-> ("select a from t order by a"-> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])-> DirDefault NullsOrderDefault]})-> ,("select a from t offset 5 row"-> ,qe {qeOffset = Just $ NumLit "5"})-> ,("select a from t offset 5 rows"-> ,qe {qeOffset = Just $ NumLit "5"})-> ,("select a from t fetch first 5 row only"-> ,qe {qeFetchFirst = Just $ NumLit "5"})-> -- todo: support with ties and percent in fetch-> --,("select a from t fetch next 5 rows with ties"-> --,("select a from t fetch first 5 percent rows only"-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"], Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }---== 7.14 <search or cycle clause>--Function--Specify the generation of ordering and cycle detection information in-the result of recursive query expressions.--<search or cycle clause> ::=- <search clause>- | <cycle clause>- | <search clause> <cycle clause>--<search clause> ::= SEARCH <recursive search order> SET <sequence column>--<recursive search order> ::=- DEPTH FIRST BY <column name list>- | BREADTH FIRST BY <column name list>--<sequence column> ::= <column name>--<cycle clause> ::=- CYCLE <cycle column list> SET <cycle mark column> TO <cycle mark value>- DEFAULT <non-cycle mark value> USING <path column>--<cycle column list> ::= <cycle column> [ { <comma> <cycle column> }... ]--<cycle column> ::= <column name>--<cycle mark column> ::= <column name>--<path column> ::= <column name>--<cycle mark value> ::= <value expression>--<non-cycle mark value> ::= <value expression>--> searchOrCycleClause :: TestItem-> searchOrCycleClause = Group "search or cycle clause"-> [-- todo: search or cycle clause-> ]--== 7.15 <subquery>--Function--Specify a scalar value, a row, or a table derived from a <query-expression>.--<scalar subquery> ::= <subquery>--<row subquery> ::= <subquery>--<table subquery> ::= <subquery>--<subquery> ::= <left paren> <query expression> <right paren>--> scalarSubquery :: TestItem-> scalarSubquery = Group "scalar subquery"-> [-- todo: scalar subquery-> ]--= 8 Predicates--== 8.1 <predicate>--Function-Specify a condition that can be evaluated to give a boolean value.--<predicate> ::=- <comparison predicate>- | <between predicate>- | <in predicate>- | <like predicate>- | <similar predicate>- | <regex like predicate>- | <null predicate>- | <quantified comparison predicate>- | <exists predicate>- | <unique predicate>- | <normalized predicate>- | <match predicate>- | <overlaps predicate>- | <distinct predicate>- | <member predicate>- | <submultiset predicate>- | <set predicate>- | <type predicate>- | <period predicate>--> predicates :: TestItem-> predicates = Group "predicates"-> [comparisonPredicates-> ,betweenPredicate-> ,inPredicate-> ,likePredicate-> ,similarPredicate-> ,regexLikePredicate-> ,nullPredicate-> ,quantifiedComparisonPredicate-> ,existsPredicate-> ,uniquePredicate-> ,normalizedPredicate-> ,matchPredicate-> ,overlapsPredicate-> ,distinctPredicate-> ,memberPredicate-> ,submultisetPredicate-> ,setPredicate-> ,periodPredicate-> ]---== 8.1 <predicate>--No grammar--== 8.2 <comparison predicate>--Function-Specify a comparison of two row values.--<comparison predicate> ::= <row value predicand> <comparison predicate part 2>--<comparison predicate part 2> ::= <comp op> <row value predicand>--<comp op> ::=- <equals operator>- | <not equals operator>- | <less than operator>- | <greater than operator>- | <less than or equals operator>- | <greater than or equals operator>--> comparisonPredicates :: TestItem-> comparisonPredicates = Group "comparison predicates"-> $ map (uncurry (TestScalarExpr ansi2011))-> $ map mkOp ["=", "<>", "<", ">", "<=", ">="]-> ++ [("ROW(a) = ROW(b)"-> ,BinOp (App [Name Nothing "ROW"] [a])-> [Name Nothing "="]-> (App [Name Nothing "ROW"] [b]))-> ,("(a,b) = (c,d)"-> ,BinOp (SpecialOp [Name Nothing "rowctor"] [a,b])-> [Name Nothing "="]-> (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "c"], Iden [Name Nothing "d"]]))-> ]-> where-> mkOp nm = ("a " ++ nm ++ " b"-> ,BinOp a [Name Nothing nm] b)-> a = Iden [Name Nothing "a"]-> b = Iden [Name Nothing "b"]--TODO: what other tests, more complex expressions with comparisons?--== 8.3 <between predicate>--Function-Specify a range comparison.--<between predicate> ::= <row value predicand> <between predicate part 2>--<between predicate part 2> ::=- [ NOT ] BETWEEN [ ASYMMETRIC | SYMMETRIC ]- <row value predicand> AND <row value predicand>--> betweenPredicate :: TestItem-> betweenPredicate = Group "between predicate"-> [-- todo: between predicate-> ]--== 8.4 <in predicate>--Function-Specify a quantified comparison.--<in predicate> ::= <row value predicand> <in predicate part 2>--<in predicate part 2> ::= [ NOT ] IN <in predicate value>--<in predicate value> ::=- <table subquery>- | <left paren> <in value list> <right paren>--<in value list> ::=- <row value expression> [ { <comma> <row value expression> }... ]--> inPredicate :: TestItem-> inPredicate = Group "in predicate"-> [-- todo: in predicate-> ]--== 8.5 <like predicate>--Function-Specify a pattern-match comparison.--<like predicate> ::= <character like predicate> | <octet like predicate>--<character like predicate> ::=- <row value predicand> <character like predicate part 2>--<character like predicate part 2> ::=- [ NOT ] LIKE <character pattern> [ ESCAPE <escape character> ]--<character pattern> ::= <character value expression>--<escape character> ::= <character value expression>--<octet like predicate> ::= <row value predicand> <octet like predicate part 2>--<octet like predicate part 2> ::=- [ NOT ] LIKE <octet pattern> [ ESCAPE <escape octet> ]--<octet pattern> ::= <binary value expression>--<escape octet> ::= <binary value expression>--> likePredicate :: TestItem-> likePredicate = Group "like predicate"-> [-- todo: like predicate-> ]--== 8.6 <similar predicate>--Function-Specify a character string similarity by means of a regular expression.--<similar predicate> ::= <row value predicand> <similar predicate part 2>--<similar predicate part 2> ::=- [ NOT ] SIMILAR TO <similar pattern> [ ESCAPE <escape character> ]--<similar pattern> ::= <character value expression>--<regular expression> ::=- <regular term>- | <regular expression> <vertical bar> <regular term>--<regular term> ::= <regular factor> | <regular term> <regular factor>--<regular factor> ::=- <regular primary>- | <regular primary> <asterisk>- | <regular primary> <plus sign>- | <regular primary> <question mark>- | <regular primary> <repeat factor>--<repeat factor> ::= <left brace> <low value> [ <upper limit> ] <right brace>--<upper limit> ::= <comma> [ <high value> ]--<low value> ::= <unsigned integer>--<high value> ::= <unsigned integer>--<regular primary> ::=- <character specifier>- | <percent>- | <regular character set>- | <left paren> <regular expression> <right paren>--<character specifier> ::= <non-escaped character> | <escaped character>--<non-escaped character> ::= !! See the Syntax Rules.--<escaped character> ::= !! See the Syntax Rules.--<regular character set> ::=- <underscore>- | <left bracket> <character enumeration>... <right bracket>- | <left bracket> <circumflex> <character enumeration>... <right bracket>- | <left bracket> <character enumeration include>...- <circumflex> <character enumeration exclude>... <right bracket>--<character enumeration include> ::= <character enumeration>--<character enumeration exclude> ::= <character enumeration>--<character enumeration> ::=- <character specifier>- | <character specifier> <minus sign> <character specifier>- | <left bracket> <colon> <regular character set identifier> <colon> <right bracket>--<regular character set identifier> ::= <identifier>--> similarPredicate :: TestItem-> similarPredicate = Group "similar predicate"-> [-- todo: similar predicate-> ]---== 8.7 <regex like predicate>--Function-Specify a pattern-match comparison using an XQuery regular expression.--<regex like predicate> ::= <row value predicand> <regex like predicate part 2>--<regex like predicate part 2> ::=- [ NOT ] LIKE_REGEX <XQuery pattern> [ FLAG <XQuery option flag> ]--> regexLikePredicate :: TestItem-> regexLikePredicate = Group "regex like predicate"-> [-- todo: regex like predicate-> ]--== 8.8 <null predicate>--Function-Specify a test for a null value.--<null predicate> ::= <row value predicand> <null predicate part 2>--<null predicate part 2> ::= IS [ NOT ] NULL--> nullPredicate :: TestItem-> nullPredicate = Group "null predicate"-> [-- todo: null predicate-> ]--== 8.9 <quantified comparison predicate>--Function-Specify a quantified comparison.--<quantified comparison predicate> ::=- <row value predicand> <quantified comparison predicate part 2>--<quantified comparison predicate part 2> ::=- <comp op> <quantifier> <table subquery>--<quantifier> ::= <all> | <some>--<all> ::= ALL--<some> ::= SOME | ANY--> quantifiedComparisonPredicate :: TestItem-> quantifiedComparisonPredicate = Group "quantified comparison predicate"-> $ map (uncurry (TestScalarExpr ansi2011))--> [("a = any (select * from t)"-> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPAny qe)-> ,("a <= some (select * from t)"-> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPSome qe)-> ,("a > all (select * from t)"-> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll qe)-> ,("(a,b) <> all (select * from t)"-> ,QuantifiedComparison-> (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"]-> ,Iden [Name Nothing "b"]]) [Name Nothing "<>"] CPAll qe)-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}--== 8.10 <exists predicate>--Function-Specify a test for a non-empty set.--<exists predicate> ::= EXISTS <table subquery>--> existsPredicate :: TestItem-> existsPredicate = Group "exists predicate"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("exists(select * from t where a = 4)"-> ,SubQueryExpr SqExists-> $ makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4"))-> }-> )]--== 8.11 <unique predicate>--Function-Specify a test for the absence of duplicate rows.--<unique predicate> ::= UNIQUE <table subquery>--> uniquePredicate :: TestItem-> uniquePredicate = Group "unique predicate"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("unique(select * from t where a = 4)"-> ,SubQueryExpr SqUnique-> $ makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> ,qeWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4"))-> }-> )]--== 8.12 <normalized predicate>--Function-Determine whether a character string value is normalized.--<normalized predicate> ::= <row value predicand> <normalized predicate part 2>--<normalized predicate part 2> ::= IS [ NOT ] [ <normal form> ] NORMALIZED--> normalizedPredicate :: TestItem-> normalizedPredicate = Group "normalized predicate"-> [-- todo: normalized predicate-> ]--== 8.13 <match predicate>--Function-Specify a test for matching rows.--<match predicate> ::= <row value predicand> <match predicate part 2>--<match predicate part 2> ::=- MATCH [ UNIQUE ] [ SIMPLE | PARTIAL | FULL ] <table subquery>--> matchPredicate :: TestItem-> matchPredicate = Group "match predicate"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("a match (select a from t)"-> ,Match (Iden [Name Nothing "a"]) False qe)-> ,("(a,b) match (select a,b from t)"-> ,Match (SpecialOp [Name Nothing "rowctor"]-> [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) False qea)-> ,("(a,b) match unique (select a,b from t)"-> ,Match (SpecialOp [Name Nothing "rowctor"]-> [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) True qea)-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}-> qea = qe {qeSelectList = qeSelectList qe-> ++ [(Iden [Name Nothing "b"],Nothing)]}--TODO: simple, partial and full--== 8.14 <overlaps predicate>--Function-Specify a test for an overlap between two datetime periods.--<overlaps predicate> ::=- <overlaps predicate part 1> <overlaps predicate part 2>--<overlaps predicate part 1> ::= <row value predicand 1>--<overlaps predicate part 2> ::= OVERLAPS <row value predicand 2>--<row value predicand 1> ::= <row value predicand>--<row value predicand 2> ::= <row value predicand>--> overlapsPredicate :: TestItem-> overlapsPredicate = Group "overlaps predicate"-> [-- todo: overlaps predicate-> ]--== 8.15 <distinct predicate>--Function-Specify a test of whether two row values are distinct--<distinct predicate> ::= <row value predicand 3> <distinct predicate part 2>--<distinct predicate part 2> ::=- IS [ NOT ] DISTINCT FROM <row value predicand 4>--<row value predicand 3> ::= <row value predicand>--<row value predicand 4> ::= <row value predicand>--> distinctPredicate :: TestItem-> distinctPredicate = Group "distinct predicate"-> [-- todo: distinct predicate-> ]--== 8.16 <member predicate>--Function-Specify a test of whether a value is a member of a multiset.--<member predicate> ::= <row value predicand> <member predicate part 2>--<member predicate part 2> ::= [ NOT ] MEMBER [ OF ] <multiset value expression>--> memberPredicate :: TestItem-> memberPredicate = Group "member predicate"-> [-- todo: member predicate-> ]--== 8.17 <submultiset predicate>--Function-Specify a test of whether a multiset is a submultiset of another multiset.--<submultiset predicate> ::=- <row value predicand> <submultiset predicate part 2>--<submultiset predicate part 2> ::=- [ NOT ] SUBMULTISET [ OF ] <multiset value expression>--> submultisetPredicate :: TestItem-> submultisetPredicate = Group "submultiset predicate"-> [-- todo: submultiset predicate-> ]--== 8.18 <set predicate>--Function--Specify a test of whether a multiset is a set (that is, does not-contain any duplicates).--<set predicate> ::= <row value predicand> <set predicate part 2>--<set predicate part 2> ::= IS [ NOT ] A SET--> setPredicate :: TestItem-> setPredicate = Group "set predicate"-> [-- todo: set predicate-> ]--== 8.19 <type predicate>--Function-Specify a type test.--<type predicate> ::= <row value predicand> <type predicate part 2>--<type predicate part 2> ::=- IS [ NOT ] OF <left paren> <type list> <right paren>--<type list> ::=- <user-defined type specification>- [ { <comma> <user-defined type specification> }... ]--<user-defined type specification> ::=- <inclusive user-defined type specification>- | <exclusive user-defined type specification>--<inclusive user-defined type specification> ::=- <path-resolved user-defined type name>--<exclusive user-defined type specification> ::=- ONLY <path-resolved user-defined type name>--TODO: type predicate--== 8.20 <period predicate>--Function-Specify a test to determine the relationship between periods.--<period predicate> ::=- <period overlaps predicate>- | <period equals predicate>- | <period contains predicate>- | <period precedes predicate>- | <period succeeds predicate>- | <period immediately precedes predicate>- | <period immediately succeeds predicate>--<period overlaps predicate> ::=- <period predicand 1> <period overlaps predicate part 2>--<period overlaps predicate part 2> ::= OVERLAPS <period predicand 2>--<period predicand 1> ::= <period predicand>--<period predicand 2> ::= <period predicand>--<period predicand> ::=- <period reference>- | PERIOD <left paren> <period start value> <comma> <period end value> <right paren>--<period reference> ::= <basic identifier chain>--<period start value> ::= <datetime value expression>--<period end value> ::= <datetime value expression>--<period equals predicate> ::=- <period predicand 1> <period equals predicate part 2>--<period equals predicate part 2> ::= EQUALS <period predicand 2>--<period contains predicate> ::=- <period predicand 1> <period contains predicate part 2>--<period contains predicate part 2> ::=- CONTAINS <period or point-in-time predicand>--<period or point-in-time predicand> ::=- <period predicand>- | <datetime value expression>--<period precedes predicate> ::=- <period predicand 1> <period precedes predicate part 2>--<period precedes predicate part 2> ::= PRECEDES <period predicand 2>--<period succeeds predicate> ::=- <period predicand 1> <period succeeds predicate part 2>--<period succeeds predicate part 2> ::= SUCCEEDS <period predicand 2>--<period immediately precedes predicate> ::=- <period predicand 1> <period immediately precedes predicate part 2>--<period immediately precedes predicate part 2> ::=- IMMEDIATELY PRECEDES <period predicand 2>--<period immediately succeeds predicate> ::=- <period predicand 1> <period immediately succeeds predicate part 2>--<period immediately succeeds predicate part 2> ::=- IMMEDIATELY SUCCEEDS <period predicand 2>--> periodPredicate :: TestItem-> periodPredicate = Group "period predicate"-> [-- todo: period predicate-> ]--== 8.21 <search condition>--Function--Specify a condition that is True, False, or Unknown, depending on the-value of a <boolean value expression>.--<search condition> ::= <boolean value expression>--= 10 Additional common elements--== 10.1 <interval qualifier>--Function-Specify the precision of an interval data type.--<interval qualifier> ::= <start field> TO <end field> | <single datetime field>--<start field> ::=- <non-second primary datetime field>- [ <left paren> <interval leading field precision> <right paren> ]--<end field> ::=- <non-second primary datetime field>- | SECOND [ <left paren> <interval fractional seconds precision> <right paren> ]--<single datetime field> ::=- <non-second primary datetime field>- [ <left paren> <interval leading field precision> <right paren> ]- | SECOND [ <left paren> <interval leading field precision>- [ <comma> <interval fractional seconds precision> ] <right paren> ]--<primary datetime field> ::= <non-second primary datetime field> | SECOND--<non-second primary datetime field> ::= YEAR | MONTH | DAY | HOUR | MINUTE--<interval fractional seconds precision> ::= <unsigned integer>--<interval leading field precision> ::= <unsigned integer>--> intervalQualifier :: TestItem-> intervalQualifier = Group "interval qualifier"-> [-- todo: interval qualifier-> ]--todo: also test all of these in the typenames and in the interval-literal tests--== 10.2 <language clause>--Function-Specify a programming language.--<language clause> ::= LANGUAGE <language name>--<language name> ::= ADA | C | COBOL | FORTRAN | M | MUMPS | PASCAL | PLI | SQL--== 10.3 <path specification>--Function-Specify an order for searching for an SQL-invoked routine.--<path specification> ::= PATH <schema name list>--<schema name list> ::= <schema name> [ { <comma> <schema name> }... ]--== 10.4 <routine invocation>--Function-Invoke an SQL-invoked routine.--<routine invocation> ::= <routine name> <SQL argument list>--<routine name> ::= [ <schema name> <period> ] <qualified identifier>--<SQL argument list> ::=- <left paren> [ <SQL argument> [ { <comma> <SQL argument> }... ] ] <right paren>--<SQL argument> ::=- <value expression>- | <generalized expression>- | <target specification>- | <contextually typed value specification>- | <named argument specification>--<generalized expression> ::=- <value expression> AS <path-resolved user-defined type name>--<named argument specification> ::=- <SQL parameter name> <named argument assignment token>- <named argument SQL argument>--<named argument SQL argument> ::=- <value expression>- | <target specification>- | <contextually typed value specification>--== 10.5 <character set specification>--Function-Identify a character set.--<character set specification> ::=- <standard character set name>- | <implementation-defined character set name>- | <user-defined character set name>--<standard character set name> ::= <character set name>--<implementation-defined character set name> ::= <character set name>--<user-defined character set name> ::= <character set name>--tested in the type names--== 10.6 <specific routine designator>--Function-Specify an SQL-invoked routine.--<specific routine designator> ::=- SPECIFIC <routine type> <specific name>- | <routine type> <member name> [ FOR <schema-resolved user-defined type name> ]--<routine type> ::=- ROUTINE- | FUNCTION- | PROCEDURE- | [ INSTANCE | STATIC | CONSTRUCTOR ] METHOD--<member name> ::= <member name alternatives> [ <data type list> ]--<member name alternatives> ::= <schema qualified routine name> | <method name>--<data type list> ::=- <left paren> [ <data type> [ { <comma> <data type> }... ] ] <right paren>--== 10.7 <collate clause>--Function-Specify a default collation.--<collate clause> ::= COLLATE <collation name>--> collateClause :: TestItem-> collateClause = Group "collate clause"-> $ map (uncurry (TestScalarExpr ansi2011))-> [("a collate my_collation"-> ,Collate (Iden [Name Nothing "a"]) [Name Nothing "my_collation"])]--== 10.8 <constraint name definition> and <constraint characteristics>--Function-Specify the name of a constraint and its characteristics.--<constraint name definition> ::= CONSTRAINT <constraint name>--<constraint characteristics> ::=- <constraint check time> [ [ NOT ] DEFERRABLE ] [ <constraint enforcement> ]- | [ NOT ] DEFERRABLE [ <constraint check time> ] [ <constraint enforcement> ]- | <constraint enforcement>--<constraint check time> ::= INITIALLY DEFERRED | INITIALLY IMMEDIATE--<constraint enforcement> ::= [ NOT ] ENFORCED--== 10.9 <aggregate function>--Function-Specify a value computed from a collection of rows.--<aggregate function> ::=- COUNT <left paren> <asterisk> <right paren> [ <filter clause> ]- | <general set function> [ <filter clause> ]- | <binary set function> [ <filter clause> ]- | <ordered set function> [ <filter clause> ]- | <array aggregate function> [ <filter clause> ]--<general set function> ::=- <set function type> <left paren> [ <set quantifier> ]- <value expression> <right paren>--<set function type> ::= <computational operation>--<computational operation> ::=- AVG- | MAX- | MIN- | SUM- | EVERY- | ANY- | SOME- | COUNT- | STDDEV_POP- | STDDEV_SAMP- | VAR_SAMP- | VAR_POP- | COLLECT- | FUSION- | INTERSECTION--<set quantifier> ::= DISTINCT | ALL--<filter clause> ::= FILTER <left paren> WHERE <search condition> <right paren>--<binary set function> ::=- <binary set function type> <left paren> <dependent variable expression> <comma>- <independent variable expression> <right paren>--<binary set function type> ::=- COVAR_POP- | COVAR_SAMP- | CORR- | REGR_SLOPE- | REGR_INTERCEPT- | REGR_COUNT- | REGR_R2- | REGR_AVGX- | REGR_AVGY- | REGR_SXX- | REGR_SYY- | REGR_SXY--<dependent variable expression> ::= <numeric value expression>--<independent variable expression> ::= <numeric value expression>--<ordered set function> ::=- <hypothetical set function>- | <inverse distribution function>--<hypothetical set function> ::=- <rank function type> <left paren>- <hypothetical set function value expression list> <right paren>- <within group specification>--<within group specification> ::=- WITHIN GROUP <left paren> ORDER BY <sort specification list> <right paren>--<hypothetical set function value expression list> ::=- <value expression> [ { <comma> <value expression> }... ]--<inverse distribution function> ::=- <inverse distribution function type> <left paren>- <inverse distribution function argument> <right paren>- <within group specification>--<inverse distribution function argument> ::= <numeric value expression>--<inverse distribution function type> ::= PERCENTILE_CONT | PERCENTILE_DISC--<array aggregate function> ::=- ARRAY_AGG- <left paren> <value expression> [ ORDER BY <sort specification list> ] <right paren>--> aggregateFunction :: TestItem-> aggregateFunction = Group "aggregate function"-> $ map (uncurry (TestScalarExpr ansi2011)) $-> [("count(*)",App [Name Nothing "count"] [Star])-> ,("count(*) filter (where something > 5)"-> ,AggregateApp [Name Nothing "count"] SQDefault [Star] [] fil)--gsf--> ,("count(a)",App [Name Nothing "count"] [Iden [Name Nothing "a"]])-> ,("count(distinct a)"-> ,AggregateApp [Name Nothing "count"]-> Distinct-> [Iden [Name Nothing "a"]] [] Nothing)-> ,("count(all a)"-> ,AggregateApp [Name Nothing "count"]-> All-> [Iden [Name Nothing "a"]] [] Nothing)-> ,("count(all a) filter (where something > 5)"-> ,AggregateApp [Name Nothing "count"]-> All-> [Iden [Name Nothing "a"]] [] fil)-> ] ++ concatMap mkSimpleAgg-> ["avg","max","min","sum"-> ,"every", "any", "some"-> ,"stddev_pop","stddev_samp","var_samp","var_pop"-> ,"collect","fusion","intersection"]--bsf--> ++ concatMap mkBsf-> ["COVAR_POP","COVAR_SAMP","CORR","REGR_SLOPE"-> ,"REGR_INTERCEPT","REGR_COUNT","REGR_R2"-> ,"REGR_AVGX","REGR_AVGY"-> ,"REGR_SXX","REGR_SYY","REGR_SXY"]--osf--> ++-> [("rank(a,c) within group (order by b)"-> ,AggregateAppGroup [Name Nothing "rank"]-> [Iden [Name Nothing "a"], Iden [Name Nothing "c"]]-> ob)]-> ++ map mkGp ["dense_rank","percent_rank"-> ,"cume_dist", "percentile_cont"-> ,"percentile_disc"]-> ++ [("array_agg(a)", App [Name Nothing "array_agg"] [Iden [Name Nothing "a"]])-> ,("array_agg(a order by z)"-> ,AggregateApp [Name Nothing "array_agg"]-> SQDefault-> [Iden [Name Nothing "a"]]-> [SortSpec (Iden [Name Nothing "z"])-> DirDefault NullsOrderDefault]-> Nothing)]--> where-> fil = Just $ BinOp (Iden [Name Nothing "something"]) [Name Nothing ">"] (NumLit "5")-> ob = [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault]-> mkGp nm = (nm ++ "(a) within group (order by b)"-> ,AggregateAppGroup [Name Nothing nm]-> [Iden [Name Nothing "a"]]-> ob)--> mkSimpleAgg nm =-> [(nm ++ "(a)",App [Name Nothing nm] [Iden [Name Nothing "a"]])-> ,(nm ++ "(distinct a)"-> ,AggregateApp [Name Nothing nm]-> Distinct-> [Iden [Name Nothing "a"]] [] Nothing)]-> mkBsf nm =-> [(nm ++ "(a,b)",App [Name Nothing nm] [Iden [Name Nothing "a"],Iden [Name Nothing "b"]])-> ,(nm ++"(a,b) filter (where something > 5)"-> ,AggregateApp [Name Nothing nm]-> SQDefault-> [Iden [Name Nothing "a"],Iden [Name Nothing "b"]] [] fil)]--== 10.10 <sort specification list>--Function-Specify a sort order.--<sort specification list> ::=- <sort specification> [ { <comma> <sort specification> }... ]--<sort specification> ::=- <sort key> [ <ordering specification> ] [ <null ordering> ]--<sort key> ::= <value expression>--<ordering specification> ::= ASC | DESC--<null ordering> ::=- | NULLS LAST- NULLS FIRST--> sortSpecificationList :: TestItem-> sortSpecificationList = Group "sort specification list"-> $ map (uncurry (TestQueryExpr ansi2011))-> [("select * from t order by a"-> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a,b"-> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])-> DirDefault NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a asc,b"-> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])-> Asc NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a desc,b"-> ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])-> Desc NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a collate x desc,b"-> ,qe {qeOrderBy = [SortSpec-> (Collate (Iden [Name Nothing "a"]) [Name Nothing "x"])-> Desc NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by 1,2"-> ,qe {qeOrderBy = [SortSpec (NumLit "1")-> DirDefault NullsOrderDefault-> ,SortSpec (NumLit "2")-> DirDefault NullsOrderDefault]})-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]}
− tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
@@ -1,2057 +0,0 @@--Section 11 in Foundation--This module covers the tests for parsing schema and DDL statements.--> module Language.SQL.SimpleSQL.SQL2011Schema (sql2011SchemaTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> sql2011SchemaTests :: TestItem-> sql2011SchemaTests = Group "sql 2011 schema tests"-> [---11.1 <schema definition>--<schema definition> ::=- CREATE SCHEMA <schema name clause>- [ <schema character set or path> ]- [ <schema element>... ]--> (TestStatement ansi2011 "create schema my_schema"-> $ CreateSchema [Name Nothing "my_schema"])--todo: schema name can have .-schema name can be quoted iden or unicode quoted iden-add schema element support:- create a list of schema elements- then do pairwise combinations in schema element list to test---<schema character set or path> ::=- <schema character set specification>- | <schema path specification>- | <schema character set specification> <schema path specification>- | <schema path specification> <schema character set specification>--<schema name clause> ::=- <schema name>- | AUTHORIZATION <schema authorization identifier>- | <schema name> AUTHORIZATION <schema authorization identifier>--<schema authorization identifier> ::=- <authorization identifier>--<schema character set specification> ::=- DEFAULT CHARACTER SET <character set specification>--<schema path specification> ::=- <path specification>--<schema element> ::=- <table definition>- | <view definition>- | <domain definition>- | <character set definition>- | <collation definition>- | <transliteration definition>- | <assertion definition>- | <trigger definition>- | <user-defined type definition>- | <user-defined cast definition>- | <user-defined ordering definition>- | <transform definition>- | <schema routine>- | <sequence generator definition>- | <grant statement>- | <role definition>---11.2 <drop schema statement>--<drop schema statement> ::=- DROP SCHEMA <schema name> <drop behavior>--<drop behavior> ::=- CASCADE- | RESTRICT---> ,(TestStatement ansi2011 "drop schema my_schema"-> $ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour)-> ,(TestStatement ansi2011 "drop schema my_schema cascade"-> $ DropSchema [Name Nothing "my_schema"] Cascade)-> ,(TestStatement ansi2011 "drop schema my_schema restrict"-> $ DropSchema [Name Nothing "my_schema"] Restrict)--11.3 <table definition>---<table definition> ::=- CREATE [ <table scope> ] TABLE <table name> <table contents source>- [ WITH <system versioning clause> ]- [ ON COMMIT <table commit action> ROWS ]--> ,(TestStatement ansi2011 "create table t (a int, b int);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []])---<table contents source> ::=- <table element list>- | <typed table clause>- | <as subquery clause>--<table scope> ::=- <global or local> TEMPORARY--<global or local> ::=- GLOBAL- | LOCAL--<system versioning clause> ::=- SYSTEM VERSIONING--defintely skip--<table commit action> ::=- PRESERVE- | DELETE--defintely skip--<table element list> ::=- <left paren> <table element> [ { <comma> <table element> }... ] <right paren>--<table element> ::=- <column definition>- | <table period definition>- | <table constraint definition>- | <like clause>--<typed table clause> ::=- OF <path-resolved user-defined type name> [ <subtable clause> ]- [ <typed table element list> ]--defintely skip--<typed table element list> ::=- <left paren> <typed table element>- [ { <comma> <typed table element> }... ] <right paren>--defintely skip--<typed table element> ::=- <column options>- | <table constraint definition>- | <self-referencing column specification>--defintely skip--<self-referencing column specification> ::=- REF IS <self-referencing column name> [ <reference generation> ]--defintely skip--<reference generation> ::=- SYSTEM GENERATED- | USER GENERATED- | DERIVED--defintely skip--<self-referencing column name> ::=- <column name>--defintely skip--<column options> ::=- <column name> WITH OPTIONS <column option list>--defintely skip--<column option list> ::=- [ <scope clause> ] [ <default clause> ] [ <column constraint definition>... ]--defintely skip--<subtable clause> ::=- UNDER <supertable clause>--defintely skip--<supertable clause> ::=- <supertable name>--defintely skip--<supertable name> ::=- <table name>--defintely skip--<like clause> ::=- LIKE <table name> [ <like options> ]--<like options> ::=- <like option>...--<like option> ::=- <identity option>- | <column default option>- | <generation option>--<identity option> ::=- INCLUDING IDENTITY- | EXCLUDING IDENTITY--<column default option> ::=- INCLUDING DEFAULTS- | EXCLUDING DEFAULTS--<generation option> ::=- INCLUDING GENERATED- | EXCLUDING GENERATED--<as subquery clause> ::=- [ <left paren> <column name list> <right paren> ] AS <table subquery>- <with or without data>--<with or without data> ::=- WITH NO DATA- | WITH DATA--<table period definition> ::=- <system or application time period specification>- <left paren> <period begin column name> <comma> <period end column name> <right paren>--defintely skip--<system or application time period specification> ::=- <system time period specification>- | <application time period specification>--defintely skip--<system time period specification> ::=- PERIOD FOR SYSTEM_TIME--defintely skip--<application time period specification> ::=- PERIOD FOR <application time period name>--defintely skip--<application time period name> ::=- <identifier>--defintely skip--<period begin column name> ::=- <column name>--defintely skip--<period end column name> ::=- <column name>--defintely skip---11.4 <column definition>--<column definition> ::=- <column name> [ <data type or domain name> ]- [ <default clause> | <identity column specification> | <generation clause>- | <system time period start column specification>- | <system time period end column specification> ]- [ <column constraint definition>... ]- [ <collate clause> ]--<data type or domain name> ::=- <data type>- | <domain name>--<system time period start column specification> ::=- <timestamp generation rule> AS ROW START--defintely skip--<system time period end column specification> ::=- <timestamp generation rule> AS ROW END--defintely skip--<timestamp generation rule> ::=- GENERATED ALWAYS--defintely skip--<column constraint definition> ::=- [ <constraint name definition> ] <column constraint> [ <constraint characteristics> ]--<column constraint> ::=- NOT NULL- | <unique specification>- | <references specification>- | <check constraint definition>---can have more than one-whitespace separated--one constratint:-optional name: constraint [Name]-not null | unique | references | check-todo: constraint characteristics---> ,(TestStatement ansi2011-> "create table t (a int not null);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing ColNotNullConstraint]])--> ,(TestStatement ansi2011-> "create table t (a int constraint a_not_null not null);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]])--> ,(TestStatement ansi2011-> "create table t (a int unique);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing ColUniqueConstraint]])--> ,(TestStatement ansi2011-> "create table t (a int primary key);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing ColPrimaryKeyConstraint]])--references t(a,b)- [ Full |partial| simepl]- [perm: on update [cascade | set null | set default | restrict | no action]- on delete ""--> ,(TestStatement ansi2011-> "create table t (a int references u);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> DefaultReferentialAction DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u(a));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch-> DefaultReferentialAction DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u match full);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing MatchFull-> DefaultReferentialAction DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u match partial);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing MatchPartial-> DefaultReferentialAction DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u match simple);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing MatchSimple-> DefaultReferentialAction DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u on update cascade );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> RefCascade DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u on update set null );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> RefSetNull DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u on update set default );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> RefSetDefault DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u on update no action );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> RefNoAction DefaultReferentialAction]])--> ,(TestStatement ansi2011-> "create table t (a int references u on delete cascade );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> DefaultReferentialAction RefCascade]])---> ,(TestStatement ansi2011-> "create table t (a int references u on update cascade on delete restrict );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> RefCascade RefRestrict]])--> ,(TestStatement ansi2011-> "create table t (a int references u on delete restrict on update cascade );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing $ ColReferencesConstraint-> [Name Nothing "u"] Nothing DefaultReferenceMatch-> RefCascade RefRestrict]])--TODO: try combinations and permutations of column constraints and-options---> ,(TestStatement ansi2011-> "create table t (a int check (a>5));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing-> [ColConstraintDef Nothing-> (ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]])------<identity column specification> ::=- GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY- [ <left paren> <common sequence generator options> <right paren> ]--> ,(TestStatement ansi2011 "create table t (a int generated always as identity);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])-> (Just $ IdentityColumnSpec GeneratedAlways []) []])--> ,(TestStatement ansi2011 "create table t (a int generated by default as identity);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])-> (Just $ IdentityColumnSpec GeneratedByDefault []) []])---> ,(TestStatement ansi2011-> "create table t (a int generated always as identity\n\-> \ ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])-> (Just $ IdentityColumnSpec GeneratedAlways-> [SGOStartWith 5-> ,SGOIncrementBy 5-> ,SGOMaxValue 500-> ,SGOMinValue 5-> ,SGOCycle]) []])--> ,(TestStatement ansi2011-> "create table t (a int generated always as identity\n\-> \ ( start with -4 no maxvalue no minvalue no cycle ));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])-> (Just $ IdentityColumnSpec GeneratedAlways-> [SGOStartWith (-4)-> ,SGONoMaxValue-> ,SGONoMinValue-> ,SGONoCycle]) []])--I think <common sequence generator options> is supposed to just-whitespace separated. In db2 it seems to be csv, but the grammar here-just seems to be whitespace separated, and it is just whitespace-separated in oracle... Not completely sure though. Usually db2 is-closer than oracle?--generated always (valueexpr)--<generation clause> ::=- <generation rule> AS <generation expression>--<generation rule> ::=- GENERATED ALWAYS--<generation expression> ::=- <left paren> <value expression> <right paren>--> ,(TestStatement ansi2011-> "create table t (a int, \n\-> \ a2 int generated always as (a * 2));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "a2") (TypeName [Name Nothing "int"])-> (Just $ GenerationClause-> (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []])----11.5 <default clause>--<default clause> ::=- DEFAULT <default option>--<default option> ::=- <literal>- | <datetime value function>- | USER- | CURRENT_USER- | CURRENT_ROLE- | SESSION_USER- | SYSTEM_USER- | CURRENT_CATALOG- | CURRENT_SCHEMA- | CURRENT_PATH- | <implicitly typed value specification>---> ,(TestStatement ansi2011 "create table t (a int default 0);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])-> (Just $ DefaultClause $ NumLit "0") []])----11.6 <table constraint definition>--<table constraint definition> ::=- [ <constraint name definition> ] <table constraint>- [ <constraint characteristics> ]--<table constraint> ::=- <unique constraint definition>- | <referential constraint definition>- | <check constraint definition>--11.7 <unique constraint definition>--<unique constraint definition> ::=- <unique specification> <left paren> <unique column list> [ <comma> <without overlap- specification> ] <right paren>- | UNIQUE ( VALUE )--<unique specification> ::=- UNIQUE- | PRIMARY KEY--<unique column list> ::=- <column name list>--> ,(TestStatement ansi2011-> "create table t (a int, unique (a));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"]-> ])--> ,(TestStatement ansi2011-> "create table t (a int, constraint a_unique unique (a));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef (Just [Name Nothing "a_unique"]) $-> TableUniqueConstraint [Name Nothing "a"]-> ])--todo: test permutations of column defs and table constraints--> ,(TestStatement ansi2011-> "create table t (a int, b int, unique (a,b));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef Nothing $-> TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]-> ])--> ,(TestStatement ansi2011-> "create table t (a int, b int, primary key (a,b));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef Nothing $-> TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"]-> ])---<without overlap specification> ::=- <application time period name> WITHOUT OVERLAPS--defintely skip---11.8 <referential constraint definition>--<referential constraint definition> ::=- FOREIGN KEY <left paren> <referencing column list>- [ <comma> <referencing period specification> ] <right paren>- <references specification>---> ,(TestStatement ansi2011-> "create table t (a int, b int,\n\-> \ foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef Nothing $-> TableReferencesConstraint-> [Name Nothing "a", Name Nothing "b"]-> [Name Nothing "u"]-> (Just [Name Nothing "c", Name Nothing "d"])-> MatchFull RefCascade RefRestrict-> ])--> ,(TestStatement ansi2011-> "create table t (a int,\n\-> \ constraint tfku1 foreign key (a) references u);"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef (Just [Name Nothing "tfku1"]) $-> TableReferencesConstraint-> [Name Nothing "a"]-> [Name Nothing "u"]-> Nothing DefaultReferenceMatch-> DefaultReferentialAction DefaultReferentialAction-> ])----<references specification> ::=- REFERENCES <referenced table and columns>- [ MATCH <match type> ] [ <referential triggered action> ]--<match type> ::=- FULL- | PARTIAL- | SIMPLE--<referencing column list> ::=- <column name list>--<referencing period specification> ::=- PERIOD <application time period name>--defintely skip--<referenced table and columns> ::=- <table name> [ <left paren> <referenced column list>- [ <comma> <referenced period specification> ] <right paren> ]--<referenced column list> ::=- <column name list>--<referenced period specification> ::=- PERIOD <application time period name>--defintely skip--<referential triggered action> ::=- <update rule> [ <delete rule> ]- | <delete rule> [ <update rule> ]--<update rule> ::=- ON UPDATE <referential action>--<delete rule> ::=- ON DELETE <referential action>--<referential action> ::=- CASCADE- | SET NULL- | SET DEFAULT- | RESTRICT- | NO ACTION----11.9 <check constraint definition>--<check constraint definition> ::=- CHECK <left paren> <search condition> <right paren>--> ,(TestStatement ansi2011-> "create table t (a int, b int, \n\-> \ check (a > b));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef Nothing $-> TableCheckConstraint-> (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))-> ])---> ,(TestStatement ansi2011-> "create table t (a int, b int, \n\-> \ constraint agtb check (a > b));"-> $ CreateTable [Name Nothing "t"]-> [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []-> ,TableConstraintDef (Just [Name Nothing "agtb"]) $-> TableCheckConstraint-> (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))-> ])---TODO: lots more combos of table elements-and types and the other bits in a column def--11.10 <alter table statement>--<alter table statement> ::=- ALTER TABLE <table name> <alter table action>--<alter table action> ::=- <add column definition>- | <alter column definition>- | <drop column definition>- | <add table constraint definition>- | <alter table constraint definition>- | <drop table constraint definition>- | <add table period definition>- | <drop table period definition>- | <add system versioning clause>- | <drop system versioning clause>--11.11 <add column definition>--<add column definition> ::=- ADD [ COLUMN ] <column definition>--alter table t add column a int-alter table t add a int-alter table t add a int unique not null check (a>0)--> ,(TestStatement ansi2011-> "alter table t add column a int"-> $ AlterTable [Name Nothing "t"] $ AddColumnDef-> $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []-> )--todo: more add column--11.12 <alter column definition>--<alter column definition> ::=- ALTER [ COLUMN ] <column name> <alter column action>--<alter column action> ::=- <set column default clause>- | <drop column default clause>- | <set column not null clause>- | <drop column not null clause>- | <add column scope clause>- | <drop column scope clause>- | <alter column data type clause>- | <alter identity column specification>- | <drop identity property clause>- | <drop column generation expression clause>---11.13 <set column default clause>--<set column default clause> ::=- SET <default clause>---> ,(TestStatement ansi2011-> "alter table t alter column c set default 0"-> $ AlterTable [Name Nothing "t"] $ AlterColumnSetDefault (Name Nothing "c")-> $ NumLit "0")--11.14 <drop column default clause>--<drop column default clause> ::=- DROP DEFAULT--> ,(TestStatement ansi2011-> "alter table t alter column c drop default"-> $ AlterTable [Name Nothing "t"] $ AlterColumnDropDefault (Name Nothing "c"))---11.15 <set column not null clause>--<set column not null clause> ::=- SET NOT NULL--> ,(TestStatement ansi2011-> "alter table t alter column c set not null"-> $ AlterTable [Name Nothing "t"] $ AlterColumnSetNotNull (Name Nothing "c"))--11.16 <drop column not null clause>--<drop column not null clause> ::=- DROP NOT NULL--> ,(TestStatement ansi2011-> "alter table t alter column c drop not null"-> $ AlterTable [Name Nothing "t"] $ AlterColumnDropNotNull (Name Nothing "c"))--11.17 <add column scope clause>--<add column scope clause> ::=- ADD <scope clause>--11.18 <drop column scope clause>--<drop column scope clause> ::=- DROP SCOPE <drop behavior>--11.19 <alter column data type clause>--<alter column data type clause> ::=- SET DATA TYPE <data type>--> ,(TestStatement ansi2011-> "alter table t alter column c set data type int;"-> $ AlterTable [Name Nothing "t"] $-> AlterColumnSetDataType (Name Nothing "c") (TypeName [Name Nothing "int"]))----11.20 <alter identity column specification>--<alter identity column specification> ::=- <set identity column generation clause> [ <alter identity column option>... ]- | <alter identity column option>...--<set identity column generation clause> ::=- SET GENERATED { ALWAYS | BY DEFAULT }--so you have to write set generated for alter identity?-and you have to use always or by default--makes no sense: if you just want to restart you have to explicitly set-the always or by default? you can't just leave it unchanged?--you don't write as identity like with create table, this is wrong:--alter table t alter column c set generated always as identity--but these are ok?--alter table t alter column c set generated always--alter table t alter column c set generated by default--<alter identity column option> ::=- <alter sequence generator restart option>- | SET <basic sequence generator option>--alter table t alter column c set generated always restart-alter table t alter column c set generated always restart with 4--you can just write restart--but to write others you have to repeat set? each time?--alter table t alter column c set generated always set increment by 5 set minvalue 0 set maxvalue 5 set cycle restart with 5-(no set before the restart--in create table, it looks like this:--c int generated generated always as identity (increment by 5 minvalue 0 maxvalue 5 cycle restart with 5)--why gratuituous differences???--is there no way to do this:--alter table t alter column c set generated as (a * 3)-??--UPDATE: alter sequence uses same syntax as create sequence, which is-the same sytnax as identity in create table, so overrule the sql-standard and use the same syntax in alter identity.--PLAN: TODO--don't implement alter table alter column generated now--review the syntax for generated in db2, oracle, sql server, postgres, others?--observe which features are supported, and the consistency between-create table and alter table--try to find some people to ask if the standard really is this much of-a mess or I have misunderstood the grammer, or maybe there is a good-reason for the inconsistencies?---11.21 <drop identity property clause>--<drop identity property clause> ::=- DROP IDENTITY--alter table t alter column c drop identity--included in the generated plan above--11.22 <drop column generation expression clause>--<drop column generation expression clause> ::=- DROP EXPRESSION--alter table t alter column c drop expression--included in the generated plan above---11.23 <drop column definition>--<drop column definition> ::=- DROP [ COLUMN ] <column name> <drop behavior>--> ,(TestStatement ansi2011-> "alter table t drop column c"-> $ AlterTable [Name Nothing "t"] $-> DropColumn (Name Nothing "c") DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "alter table t drop c cascade"-> $ AlterTable [Name Nothing "t"] $-> DropColumn (Name Nothing "c") Cascade)--> ,(TestStatement ansi2011-> "alter table t drop c restrict"-> $ AlterTable [Name Nothing "t"] $-> DropColumn (Name Nothing "c") Restrict)----11.24 <add table constraint definition>--<add table constraint definition> ::=- ADD <table constraint definition>--> ,(TestStatement ansi2011-> "alter table t add constraint c unique (a,b)"-> $ AlterTable [Name Nothing "t"] $-> AddTableConstraintDef (Just [Name Nothing "c"])-> $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])--> ,(TestStatement ansi2011-> "alter table t add unique (a,b)"-> $ AlterTable [Name Nothing "t"] $-> AddTableConstraintDef Nothing-> $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])---11.25 <alter table constraint definition>-<alter table constraint definition> ::=- ALTER CONSTRAINT <constraint name> <constraint enforcement>--todo--11.26 <drop table constraint definition>--<drop table constraint definition> ::=- DROP CONSTRAINT <constraint name> <drop behavior>--> ,(TestStatement ansi2011-> "alter table t drop constraint c"-> $ AlterTable [Name Nothing "t"] $-> DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "alter table t drop constraint c restrict"-> $ AlterTable [Name Nothing "t"] $-> DropTableConstraintDef [Name Nothing "c"] Restrict)--11.27 <add table period definition>--<add table period definition> ::=- ADD <table period definition> [ <add system time period column list> ]--defintely skip--<add system time period column list> ::=- ADD [ COLUMN ] <column definition 1> ADD [ COLUMN ] <column definition 2>--defintely skip--<column definition 1> ::=- <column definition>--defintely skip--<column definition 2> ::=- <column definition>--defintely skip--11.28 <drop table period definition>--<drop table period definition> ::=- DROP <system or application time period specification> <drop behavior>--defintely skip--11.29 <add system versioning clause>--<add system versioning clause> ::=- ADD <system versioning clause>--defintely skip--11.30 <drop system versioning clause>--<drop system versioning clause> ::=- DROP SYSTEM VERSIONING <drop behavior>--defintely skip--11.31 <drop table statement>--<drop table statement> ::=- DROP TABLE <table name> <drop behavior>--> ,(TestStatement ansi2011-> "drop table t"-> $ DropTable [Name Nothing "t"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "drop table t restrict"-> $ DropTable [Name Nothing "t"] Restrict)---11.32 <view definition>--<view definition> ::=- CREATE [ RECURSIVE ] VIEW <table name> <view specification>- AS <query expression> [ WITH [ <levels clause> ] CHECK OPTION ]--<view specification> ::=- <regular view specification>- | <referenceable view specification>--<regular view specification> ::=- [ <left paren> <view column list> <right paren> ]--<referenceable view specification> ::=- OF <path-resolved user-defined type name> [ <subview clause> ]- [ <view element list> ]--<subview clause> ::=- UNDER <table name>--<view element list> ::=- <left paren> <view element> [ { <comma> <view element> }... ] <right paren>--<view element> ::=- <self-referencing column specification>- | <view column option>--<view column option> ::=- <column name> WITH OPTIONS <scope clause>--<levels clause> ::=- CASCADED- | LOCAL--<view column list> ::=- <column name list>--> ,(TestStatement ansi2011-> "create view v as select * from t"-> $ CreateView False [Name Nothing "v"] Nothing (makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }) Nothing)---> ,(TestStatement ansi2011-> "create recursive view v as select * from t"-> $ CreateView True [Name Nothing "v"] Nothing (makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }) Nothing)--> ,(TestStatement ansi2011-> "create view v(a,b) as select * from t"-> $ CreateView False [Name Nothing "v"] (Just [Name Nothing "a", Name Nothing "b"])-> (makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }) Nothing)---> ,(TestStatement ansi2011-> "create view v as select * from t with check option"-> $ CreateView False [Name Nothing "v"] Nothing (makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }) (Just DefaultCheckOption))--> ,(TestStatement ansi2011-> "create view v as select * from t with cascaded check option"-> $ CreateView False [Name Nothing "v"] Nothing (makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }) (Just CascadedCheckOption))--> ,(TestStatement ansi2011-> "create view v as select * from t with local check option"-> $ CreateView False [Name Nothing "v"] Nothing-> (makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }) (Just LocalCheckOption))---11.33 <drop view statement>--<drop view statement> ::=- DROP VIEW <table name> <drop behavior>---> ,(TestStatement ansi2011-> "drop view v"-> $ DropView [Name Nothing "v"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "drop view v cascade"-> $ DropView [Name Nothing "v"] Cascade)---11.34 <domain definition>--<domain definition> ::=- CREATE DOMAIN <domain name> [ AS ] <predefined type>- [ <default clause> ]- [ <domain constraint>... ]- [ <collate clause> ]--<domain constraint> ::=- [ <constraint name definition> ] <check constraint definition> [- <constraint characteristics> ]--> ,(TestStatement ansi2011-> "create domain my_int int"-> $ CreateDomain [Name Nothing "my_int"]-> (TypeName [Name Nothing "int"])-> Nothing [])--> ,(TestStatement ansi2011-> "create domain my_int as int"-> $ CreateDomain [Name Nothing "my_int"]-> (TypeName [Name Nothing "int"])-> Nothing [])--> ,(TestStatement ansi2011-> "create domain my_int int default 0"-> $ CreateDomain [Name Nothing "my_int"]-> (TypeName [Name Nothing "int"])-> (Just (NumLit "0")) [])--> ,(TestStatement ansi2011-> "create domain my_int int check (value > 5)"-> $ CreateDomain [Name Nothing "my_int"]-> (TypeName [Name Nothing "int"])-> Nothing [(Nothing-> ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])--> ,(TestStatement ansi2011-> "create domain my_int int constraint gt5 check (value > 5)"-> $ CreateDomain [Name Nothing "my_int"]-> (TypeName [Name Nothing "int"])-> Nothing [(Just [Name Nothing "gt5"]-> ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])----11.35 <alter domain statement>--<alter domain statement> ::=- ALTER DOMAIN <domain name> <alter domain action>--<alter domain action> ::=- <set domain default clause>- | <drop domain default clause>- | <add domain constraint definition>- | <drop domain constraint definition>--11.36 <set domain default clause>--<set domain default clause> ::=- SET <default clause>--> ,(TestStatement ansi2011-> "alter domain my_int set default 0"-> $ AlterDomain [Name Nothing "my_int"]-> $ ADSetDefault $ NumLit "0")---11.37 <drop domain default clause>--<drop domain default clause> ::=- DROP DEFAULT--> ,(TestStatement ansi2011-> "alter domain my_int drop default"-> $ AlterDomain [Name Nothing "my_int"]-> $ ADDropDefault)---11.38 <add domain constraint definition>--<add domain constraint definition> ::=- ADD <domain constraint>--> ,(TestStatement ansi2011-> "alter domain my_int add check (value > 6)"-> $ AlterDomain [Name Nothing "my_int"]-> $ ADAddConstraint Nothing-> $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))--> ,(TestStatement ansi2011-> "alter domain my_int add constraint gt6 check (value > 6)"-> $ AlterDomain [Name Nothing "my_int"]-> $ ADAddConstraint (Just [Name Nothing "gt6"])-> $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))---11.39 <drop domain constraint definition>--<drop domain constraint definition> ::=- DROP CONSTRAINT <constraint name>--> ,(TestStatement ansi2011-> "alter domain my_int drop constraint gt6"-> $ AlterDomain [Name Nothing "my_int"]-> $ ADDropConstraint [Name Nothing "gt6"])--11.40 <drop domain statement>--<drop domain statement> ::=- DROP DOMAIN <domain name> <drop behavior>--> ,(TestStatement ansi2011-> "drop domain my_int"-> $ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "drop domain my_int cascade"-> $ DropDomain [Name Nothing "my_int"] Cascade)----11.41 <character set definition>--<character set definition> ::=- CREATE CHARACTER SET <character set name> [ AS ]- <character set source> [ <collate clause> ]--<character set source> ::=- GET <character set specification>--11.42 <drop character set statement>--<drop character set statement> ::=- DROP CHARACTER SET <character set name>--11.43 <collation definition>--<collation definition> ::=- CREATE COLLATION <collation name> FOR <character set specification>- FROM <existing collation name> [ <pad characteristic> ]--<existing collation name> ::=- <collation name>--<pad characteristic> ::=- NO PAD- | PAD SPACE--11.44 <drop collation statement>--<drop collation statement> ::=- DROP COLLATION <collation name> <drop behavior>--11.45 <transliteration definition>--<transliteration definition> ::=- CREATE TRANSLATION <transliteration name> FOR <source character set specification>- TO <target character set specification> FROM <transliteration source>--<source character set specification> ::=- <character set specification>--<target character set specification> ::=- <character set specification>--<transliteration source> ::=- <existing transliteration name>- | <transliteration routine>--<existing transliteration name> ::=- <transliteration name>--<transliteration routine> ::=- <specific routine designator>--11.46 <drop transliteration statement>--<drop transliteration statement> ::=- DROP TRANSLATION <transliteration name>--11.47 <assertion definition>--<assertion definition> ::=- CREATE ASSERTION <constraint name>- CHECK <left paren> <search condition> <right paren>- [ <constraint characteristics> ]--> ,(TestStatement ansi2011-> "create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);"-> $ CreateAssertion [Name Nothing "t1_not_empty"]-> $ BinOp (SubQueryExpr SqSq $-> makeSelect-> {qeSelectList = [(App [Name Nothing "count"] [Star],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t1"]]-> })-> [Name Nothing ">"] (NumLit "0"))--11.48 <drop assertion statement>--<drop assertion statement> ::=- DROP ASSERTION <constraint name> [ <drop behavior> ]--> ,(TestStatement ansi2011-> "drop assertion t1_not_empty;"-> $ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "drop assertion t1_not_empty cascade;"-> $ DropAssertion [Name Nothing "t1_not_empty"] Cascade)---11.49 <trigger definition>--<trigger definition> ::=- CREATE TRIGGER <trigger name> <trigger action time> <trigger event>- ON <table name> [ REFERENCING <transition table or variable list> ]- <triggered action>--<trigger action time> ::=- BEFORE- | AFTER- | INSTEAD OF--<trigger event> ::=- INSERT- | DELETE- | UPDATE [ OF <trigger column list> ]--<trigger column list> ::=- <column name list>--<triggered action> ::=- [ FOR EACH { ROW | STATEMENT } ]- [ <triggered when clause> ]- <triggered SQL statement>--<triggered when clause> ::=- WHEN <left paren> <search condition> <right paren>--<triggered SQL statement> ::=- <SQL procedure statement>- | BEGIN ATOMIC { <SQL procedure statement> <semicolon> }... END--<transition table or variable list> ::=- <transition table or variable>...--<transition table or variable> ::=- OLD [ ROW ] [ AS ] <old transition variable name>- | NEW [ ROW ] [ AS ] <new transition variable name>- | OLD TABLE [ AS ] <old transition table name>- | NEW TABLE [ AS ] <new transition table name>--<old transition table name> ::=- <transition table name>--<new transition table name> ::=- <transition table name>--<transition table name> ::=- <identifier>--<old transition variable name> ::=- <correlation name>--<new transition variable name> ::=- <correlation name>--11.50 <drop trigger statement>--<drop trigger statement> ::=- DROP TRIGGER <trigger name>--11.51 <user-defined type definition>--<user-defined type definition> ::=- CREATE TYPE <user-defined type body>-- <user-defined type body> ::=- <schema-resolved user-defined type name>- [ <subtype clause> ]- [ AS <representation> ]- [ <user-defined type option list> ]- [ <method specification list> ]--<user-defined type option list> ::=- <user-defined type option> [ <user-defined type option>... ]--<user-defined type option> ::=- <instantiable clause>- | <finality>- | <reference type specification>- | <cast to ref>- | <cast to type>- | <cast to distinct>- | <cast to source>--<subtype clause> ::=- UNDER <supertype name>--<supertype name> ::=- <path-resolved user-defined type name>--<representation> ::=- <predefined type>- | <collection type>- | <member list>--<member list> ::=- <left paren> <member> [ { <comma> <member> }... ] <right paren>--<member> ::=- <attribute definition>--<instantiable clause> ::=- INSTANTIABLE- | NOT INSTANTIABLE--<finality> ::=- FINAL- | NOT FINAL--<reference type specification> ::=- <user-defined representation>- | <derived representation>- | <system-generated representation>--<user-defined representation> ::=- REF USING <predefined type>--<derived representation> ::=- REF FROM <list of attributes>--<system-generated representation> ::=- REF IS SYSTEM GENERATED--<cast to ref> ::=- CAST <left paren> SOURCE AS REF <right paren> WITH <cast to ref identifier>--<cast to ref identifier> ::=- <identifier>--<cast to type> ::=- CAST <left paren> REF AS SOURCE <right paren> WITH <cast to type identifier>--<cast to type identifier> ::=- <identifier>--<list of attributes> ::=- <left paren> <attribute name> [ { <comma> <attribute name> }... ] <right paren>--<cast to distinct> ::=- CAST <left paren> SOURCE AS DISTINCT <right paren>- WITH <cast to distinct identifier>--<cast to distinct identifier> ::=- <identifier>--<cast to source> ::=- CAST <left paren> DISTINCT AS SOURCE <right paren>- WITH <cast to source identifier>--<cast to source identifier> ::=- <identifier>--<method specification list> ::=- <method specification> [ { <comma> <method specification> }... ]--<method specification> ::=- <original method specification>- | <overriding method specification>--<original method specification> ::=- <partial method specification> [ SELF AS RESULT ] [ SELF AS LOCATOR ]- [ <method characteristics> ]--<overriding method specification> ::=- OVERRIDING <partial method specification>- 1<partial method specification> ::=- [ INSTANCE | STATIC | CONSTRUCTOR ]- METHOD <method name> <SQL parameter declaration list>- <returns clause>- [ SPECIFIC <specific method name> ]--<specific method name> ::=- [ <schema name> <period> ] <qualified identifier>--<method characteristics> ::=- <method characteristic>...-- <method characteristic> ::=- <language clause>- | <parameter style clause>- | <deterministic characteristic>- | <SQL-data access indication>- | <null-call clause>--11.52 <attribute definition>--<attribute definition> ::=- <attribute name> <data type>- [ <attribute default> ]- [ <collate clause> ]--<attribute default> ::=- <default clause>--11.53 <alter type statement>--<alter type statement> ::=- ALTER TYPE <schema-resolved user-defined type name> <alter type action>--<alter type action> ::=- <add attribute definition>- | <drop attribute definition>- | <add original method specification>- | <add overriding method specification>- | <drop method specification>--11.54 <add attribute definition>--<add attribute definition> ::=- ADD ATTRIBUTE <attribute definition>--11.55 <drop attribute definition>--<drop attribute definition> ::=- DROP ATTRIBUTE <attribute name> RESTRICT--11.56 <add original method specification>--<add original method specification> ::=- ADD <original method specification>--11.57 <add overriding method specification>--<add overriding method specification> ::=- ADD <overriding method specification>--11.58 <drop method specification>--<drop method specification> ::=- DROP <specific method specification designator> RESTRICT--<specific method specification designator> ::=- [ INSTANCE | STATIC | CONSTRUCTOR ]- METHOD <method name> <data type list>--11.59 <drop data type statement>--<drop data type statement> ::=- DROP TYPE <schema-resolved user-defined type name> <drop behavior>--11.60 <SQL-invoked routine>--<SQL-invoked routine> ::=- <schema routine>--<schema routine> ::=- <schema procedure>- | <schema function>--<schema procedure> ::=- CREATE <SQL-invoked procedure>--<schema function> ::=- CREATE <SQL-invoked function>--<SQL-invoked procedure> ::=- PROCEDURE <schema qualified routine name> <SQL parameter declaration list>- <routine characteristics>- <routine body>--<SQL-invoked function> ::=- { <function specification> | <method specification designator> } <routine body>--<SQL parameter declaration list> ::=- <left paren> [ <SQL parameter declaration>- [ { <comma> <SQL parameter declaration> }... ] ] <right paren>--<SQL parameter declaration> ::=- [ <parameter mode> ]- [ <SQL parameter name> ]- <parameter type> [ RESULT ]- [ DEFAULT <parameter default> ]--<parameter default> ::=- <value expression>- | <contextually typed value specification>--<parameter mode> ::=- IN- | OUT- | INOUT--<parameter type> ::=- <data type> [ <locator indication> ]--<locator indication> ::=- AS LOCATOR--<function specification> ::=- FUNCTION <schema qualified routine name> <SQL parameter declaration list>- <returns clause>- <routine characteristics>- [ <dispatch clause> ]--<method specification designator> ::=- SPECIFIC METHOD <specific method name>- | [ INSTANCE | STATIC | CONSTRUCTOR ]- METHOD <method name> <SQL parameter declaration list>- [ <returns clause> ]- FOR <schema-resolved user-defined type name>--<routine characteristics> ::=- [ <routine characteristic>... ]--<routine characteristic> ::=- <language clause>- | <parameter style clause>- | SPECIFIC <specific name>- | <deterministic characteristic>- | <SQL-data access indication>- | <null-call clause>- | <returned result sets characteristic>- | <savepoint level indication>--<savepoint level indication> ::=- NEW SAVEPOINT LEVEL- | OLD SAVEPOINT LEVEL--<returned result sets characteristic> ::=- DYNAMIC RESULT SETS <maximum returned result sets>--<parameter style clause> ::=- PARAMETER STYLE <parameter style>--<dispatch clause> ::=- STATIC DISPATCH--<returns clause> ::=- RETURNS <returns type>--<returns type> ::=- <returns data type> [ <result cast> ]- | <returns table type>--<returns table type> ::=- TABLE <table function column list>--<table function column list> ::=- <left paren> <table function column list element>- [ { <comma> <table function column list element> }... ] <right paren>--<table function column list element> ::=- <column name> <data type>--<result cast> ::=- CAST FROM <result cast from type>--<result cast from type> ::=- <data type> [ <locator indication> ]--<returns data type> ::=- <data type> [ <locator indication> ]--<routine body> ::=- <SQL routine spec>- | <external body reference>--<SQL routine spec> ::=- [ <rights clause> ] <SQL routine body>--<rights clause> ::=- SQL SECURITY INVOKER- | SQL SECURITY DEFINER--<SQL routine body> ::=- <SQL procedure statement>--<external body reference> ::=- EXTERNAL [ NAME <external routine name> ]- [ <parameter style clause> ]- [ <transform group specification> ]- [ <external security clause> ]--<external security clause> ::=- EXTERNAL SECURITY DEFINER- | EXTERNAL SECURITY INVOKER- | EXTERNAL SECURITY IMPLEMENTATION DEFINED--<parameter style> ::=- SQL- | GENERAL--<deterministic characteristic> ::=- DETERMINISTIC- | NOT DETERMINISTIC--<SQL-data access indication> ::=- NO SQL- | CONTAINS SQL- | READS SQL DATA- | MODIFIES SQL DATA--<null-call clause> ::=- RETURNS NULL ON NULL INPUT- | CALLED ON NULL INPUT--<maximum returned result sets> ::=- <unsigned integer>--<transform group specification> ::=- TRANSFORM GROUP { <single group specification> | <multiple group specification> }--<single group specification> ::=- <group name>--<multiple group specification> ::=- <group specification> [ { <comma> <group specification> }... ]--<group specification> ::=- <group name> FOR TYPE <path-resolved user-defined type name>--11.61 <alter routine statement>--<alter routine statement> ::=- ALTER <specific routine designator>- <alter routine characteristics> <alter routine behavior>--<alter routine characteristics> ::=- <alter routine characteristic>...--<alter routine characteristic> ::=- <language clause>- | <parameter style clause>- | <SQL-data access indication>- | <null-call clause>- | <returned result sets characteristic>- | NAME <external routine name>--<alter routine behavior> ::=- RESTRICT--11.62 <drop routine statement>--<drop routine statement> ::=- DROP <specific routine designator> <drop behavior>--11.63 <user-defined cast definition>--<user-defined cast definition> ::=- CREATE CAST <left paren> <source data type> AS <target data type> <right paren>- WITH <cast function>- [ AS ASSIGNMENT ]--<cast function> ::=- <specific routine designator>--<source data type> ::=- <data type>--<target data type> ::=- <data type>--11.64 <drop user-defined cast statement>--<drop user-defined cast statement> ::=- DROP CAST <left paren> <source data type> AS <target data type> <right paren>- <drop behavior>--11.65 <user-defined ordering definition>--<user-defined ordering definition> ::=- CREATE ORDERING FOR <schema-resolved user-defined type name> <ordering form>--<ordering form> ::=- <equals ordering form>- | <full ordering form>--<equals ordering form> ::=- EQUALS ONLY BY <ordering category>--<full ordering form> ::=- ORDER FULL BY <ordering category>--<ordering category> ::=- <relative category>- | <map category>- | <state category>--<relative category> ::=- RELATIVE WITH <relative function specification>--<map category> ::=- MAP WITH <map function specification>--<state category> ::=- STATE [ <specific name> ]--<relative function specification> ::=- <specific routine designator>--<map function specification> ::=- <specific routine designator>--11.66 <drop user-defined ordering statement>--<drop user-defined ordering statement> ::=- DROP ORDERING FOR <schema-resolved user-defined type name> <drop behavior>--11.67 <transform definition>--<transform definition> ::=- CREATE { TRANSFORM | TRANSFORMS } FOR- <schema-resolved user-defined type name> <transform group>...--<transform group> ::=- <group name> <left paren> <transform element list> <right paren>--<group name> ::=- <identifier>--<transform element list> ::=- <transform element> [ <comma> <transform element> ]--<transform element> ::=- <to sql>- | <from sql>--<to sql> ::=- TO SQL WITH <to sql function>--<from sql> ::=- FROM SQL WITH <from sql function>--<to sql function> ::=- <specific routine designator>--<from sql function> ::=- <specific routine designator>--11.68 <alter transform statement>--<alter transform statement> ::=- ALTER { TRANSFORM | TRANSFORMS }- FOR <schema-resolved user-defined type name> <alter group>...--<alter group> ::=- <group name> <left paren> <alter transform action list> <right paren>--<alter transform action list> ::=- <alter transform action> [ { <comma> <alter transform action> }... ]--<alter transform action> ::=- <add transform element list>- | <drop transform element list>--11.69 <add transform element list>--<add transform element list> ::=- ADD <left paren> <transform element list> <right paren>--11.70 <drop transform element list>--<drop transform element list> ::=- DROP <left paren> <transform kind>- [ <comma> <transform kind> ] <drop behavior> <right paren>--<transform kind> ::=- TO SQL- | FROM SQL--11.71 <drop transform statement>--<drop transform statement> ::=- DROP { TRANSFORM | TRANSFORMS } <transforms to be dropped>- FOR <schema-resolved user-defined type name> <drop behavior>--<transforms to be dropped> ::=- ALL- | <transform group element>--<transform group element> ::=- <group name>--11.72 <sequence generator definition>--<sequence generator definition> ::=- CREATE SEQUENCE <sequence generator name> [ <sequence generator options> ]--<sequence generator options> ::=- <sequence generator option>...--<sequence generator option> ::=- <sequence generator data type option>- | <common sequence generator options>--<common sequence generator options> ::=- <common sequence generator option>...--<common sequence generator option> ::=- <sequence generator start with option>- | <basic sequence generator option>--<basic sequence generator option> ::=- <sequence generator increment by option>- | <sequence generator maxvalue option>- | <sequence generator minvalue option>- | <sequence generator cycle option>--<sequence generator data type option> ::=- AS <data type>--<sequence generator start with option> ::=- START WITH <sequence generator start value>--<sequence generator start value> ::=- <signed numeric literal>--<sequence generator increment by option> ::=- INCREMENT BY <sequence generator increment>--<sequence generator increment> ::=- <signed numeric literal>--<sequence generator maxvalue option> ::=- MAXVALUE <sequence generator max value>- | NO MAXVALUE--<sequence generator max value> ::=- <signed numeric literal>--<sequence generator minvalue option> ::=- MINVALUE <sequence generator min value>- | NO MINVALUE--<sequence generator min value> ::=- <signed numeric literal>--<sequence generator cycle option> ::=- CYCLE- | NO CYCLE--> ,(TestStatement ansi2011-> "create sequence seq"-> $ CreateSequence [Name Nothing "seq"] [])--> ,(TestStatement ansi2011-> "create sequence seq as bigint"-> $ CreateSequence [Name Nothing "seq"]-> [SGODataType $ TypeName [Name Nothing "bigint"]])--> ,(TestStatement ansi2011-> "create sequence seq as bigint start with 5"-> $ CreateSequence [Name Nothing "seq"]-> [SGOStartWith 5-> ,SGODataType $ TypeName [Name Nothing "bigint"]-> ])---11.73 <alter sequence generator statement>--<alter sequence generator statement> ::=- ALTER SEQUENCE <sequence generator name> <alter sequence generator options>--<alter sequence generator options> ::=- <alter sequence generator option>...--<alter sequence generator option> ::=- <alter sequence generator restart option>- | <basic sequence generator option>--<alter sequence generator restart option> ::=- RESTART [ WITH <sequence generator restart value> ]--<sequence generator restart value> ::=- <signed numeric literal>--> ,(TestStatement ansi2011-> "alter sequence seq restart"-> $ AlterSequence [Name Nothing "seq"]-> [SGORestart Nothing])--> ,(TestStatement ansi2011-> "alter sequence seq restart with 5"-> $ AlterSequence [Name Nothing "seq"]-> [SGORestart $ Just 5])--> ,(TestStatement ansi2011-> "alter sequence seq restart with 5 increment by 5"-> $ AlterSequence [Name Nothing "seq"]-> [SGORestart $ Just 5-> ,SGOIncrementBy 5])---11.74 <drop sequence generator statement>--<drop sequence generator statement> ::=- DROP SEQUENCE <sequence generator name> <drop behavior>--> ,(TestStatement ansi2011-> "drop sequence seq"-> $ DropSequence [Name Nothing "seq"] DefaultDropBehaviour)--> ,(TestStatement ansi2011-> "drop sequence seq restrict"-> $ DropSequence [Name Nothing "seq"] Restrict)---> ]
− tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
@@ -1,417 +0,0 @@--Tests for parsing scalar expressions--> module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> scalarExprTests :: TestItem-> scalarExprTests = Group "scalarExprTests"-> [literals-> ,identifiers-> ,star-> ,parameter-> ,dots-> ,app-> ,caseexp-> ,operators-> ,parens-> ,subqueries-> ,aggregates-> ,windowFunctions-> ,functionsWithReservedNames-> ]--> literals :: TestItem-> literals = Group "literals" $ map (uncurry (TestScalarExpr ansi2011))-> [("3", NumLit "3")-> ,("3.", NumLit "3.")-> ,("3.3", NumLit "3.3")-> ,(".3", NumLit ".3")-> ,("3.e3", NumLit "3.e3")-> ,("3.3e3", NumLit "3.3e3")-> ,(".3e3", NumLit ".3e3")-> ,("3e3", NumLit "3e3")-> ,("3e+3", NumLit "3e+3")-> ,("3e-3", NumLit "3e-3")-> ,("'string'", StringLit "'" "'" "string")-> ,("'string with a '' quote'", StringLit "'" "'" "string with a '' quote")-> ,("'1'", StringLit "'" "'" "1")-> ,("interval '3' day"-> ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)-> ,("interval '3' day (3)"-> ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing)-> ,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks")-> ]--> identifiers :: TestItem-> identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))-> [("iden1", Iden [Name Nothing "iden1"])-> --,("t.a", Iden2 "t" "a")-> ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])-> ,("\"from\"", Iden [Name (Just ("\"","\"")) "from"])-> ]--> star :: TestItem-> star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))-> [("*", Star)-> --,("t.*", Star2 "t")-> --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])-> ]--> parameter :: TestItem-> parameter = Group "parameter"-> [TestScalarExpr ansi2011 "?" Parameter-> ,TestScalarExpr postgres "$13" $ PositionalArg 13]---> dots :: TestItem-> dots = Group "dot" $ map (uncurry (TestScalarExpr ansi2011))-> [("t.a", Iden [Name Nothing "t",Name Nothing "a"])-> ,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star)-> ,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"])-> ,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"])-> ]--> app :: TestItem-> app = Group "app" $ map (uncurry (TestScalarExpr ansi2011))-> [("f()", App [Name Nothing "f"] [])-> ,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]])-> ,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])-> ]--> caseexp :: TestItem-> caseexp = Group "caseexp" $ map (uncurry (TestScalarExpr ansi2011))-> [("case a when 1 then 2 end"-> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]-> ,NumLit "2")] Nothing)--> ,("case a when 1 then 2 when 3 then 4 end"-> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")-> ,([NumLit "3"], NumLit "4")] Nothing)--> ,("case a when 1 then 2 when 3 then 4 else 5 end"-> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")-> ,([NumLit "3"], NumLit "4")]-> (Just $ NumLit "5"))--> ,("case when a=1 then 2 when a=3 then 4 else 5 end"-> ,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2")-> ,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")]-> (Just $ NumLit "5"))--> ,("case a when 1,2 then 10 when 3,4 then 20 end"-> ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"]-> ,NumLit "10")-> ,([NumLit "3",NumLit "4"]-> ,NumLit "20")]-> Nothing)--> ]--> operators :: TestItem-> operators = Group "operators"-> [binaryOperators-> ,unaryOperators-> ,casts-> ,miscOps]--> binaryOperators :: TestItem-> binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))-> [("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))-> -- sanity check fixities-> -- todo: add more fixity checking--> ,("a + b * c"-> ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]-> (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])))--> ,("a * b + c"-> ,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"]))-> [Name Nothing "+"] (Iden [Name Nothing "c"]))-> ]--> unaryOperators :: TestItem-> unaryOperators = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))-> [("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])-> ,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])-> ,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"])-> ,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"])-> ]---> casts :: TestItem-> casts = Group "operators" $ map (uncurry (TestScalarExpr ansi2011))-> [("cast('1' as int)"-> ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"])--> ,("int '3'"-> ,TypedLit (TypeName [Name Nothing "int"]) "3")--> ,("cast('1' as double precision)"-> ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])--> ,("cast('1' as float(8))"-> ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8)--> ,("cast('1' as decimal(15,2))"-> ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2)---> ,("double precision '3'"-> ,TypedLit (TypeName [Name Nothing "double precision"]) "3")-> ]--> subqueries :: TestItem-> subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))-> [("exists (select a from t)", SubQueryExpr SqExists ms)-> ,("(select a from t)", SubQueryExpr SqSq ms)--> ,("a in (select a from t)"-> ,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))--> ,("a not in (select a from t)"-> ,In False (Iden [Name Nothing "a"]) (InQueryExpr ms))--> ,("a > all (select a from t)"-> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)--> ,("a = some (select a from t)"-> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms)--> ,("a <= any (select a from t)"-> ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms)-> ]-> where-> ms = makeSelect-> {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = [TRSimple [Name Nothing "t"]]-> }--> miscOps :: TestItem-> miscOps = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))-> [("a in (1,2,3)"-> ,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"])--> ,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"]))-> ,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"]))-> ,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"]))-> ,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"]))-> ,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"]))-> ,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"]))-> ,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"]))-> ,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"]))-> ,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"]))--> ,("a is not distinct from b"-> ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"]))--> ,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"]))-> ,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"]))-> ,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"]))--> ,("a is not similar to b"-> ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"]))--> ,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"]))---special operators--> ,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]-> ,Iden [Name Nothing "b"]-> ,Iden [Name Nothing "c"]])--> ,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]-> ,Iden [Name Nothing "b"]-> ,Iden [Name Nothing "c"]])-> ,("(1,2)"-> ,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"])---keyword special operators--> ,("extract(day from t)"-> , SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])--> ,("substring(x from 1 for 2)"-> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")-> ,("for", NumLit "2")])--> ,("substring(x from 1)"-> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")])--> ,("substring(x for 2)"-> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")])--> ,("substring(x from 1 for 2 collate C)"-> ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"])-> [("from", NumLit "1")-> ,("for", Collate (NumLit "2") [Name Nothing "C"])])--this doesn't work because of a overlap in the 'in' parser--> ,("POSITION( string1 IN string2 )"-> ,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])])--> ,("CONVERT(char_value USING conversion_char_name)"-> ,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])-> [("using", Iden [Name Nothing "conversion_char_name"])])--> ,("TRANSLATE(char_value USING translation_name)"-> ,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"])-> [("using", Iden [Name Nothing "translation_name"])])--OVERLAY(string PLACING embedded_string FROM start-[FOR length])--> ,("OVERLAY(string PLACING embedded_string FROM start)"-> ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])-> [("placing", Iden [Name Nothing "embedded_string"])-> ,("from", Iden [Name Nothing "start"])])--> ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"-> ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])-> [("placing", Iden [Name Nothing "embedded_string"])-> ,("from", Iden [Name Nothing "start"])-> ,("for", Iden [Name Nothing "length"])])--TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]-target_string-[COLLATE collation_name] )----> ,("trim(from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("both", StringLit "'" "'" " ")-> ,("from", Iden [Name Nothing "target_string"])])--> ,("trim(leading from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("leading", StringLit "'" "'" " ")-> ,("from", Iden [Name Nothing "target_string"])])--> ,("trim(trailing from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("trailing", StringLit "'" "'" " ")-> ,("from", Iden [Name Nothing "target_string"])])--> ,("trim(both from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("both", StringLit "'" "'" " ")-> ,("from", Iden [Name Nothing "target_string"])])---> ,("trim(leading 'x' from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("leading", StringLit "'" "'" "x")-> ,("from", Iden [Name Nothing "target_string"])])--> ,("trim(trailing 'y' from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("trailing", StringLit "'" "'" "y")-> ,("from", Iden [Name Nothing "target_string"])])--> ,("trim(both 'z' from target_string collate C)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("both", StringLit "'" "'" "z")-> ,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])])--> ,("trim(leading from target_string)"-> ,SpecialOpK [Name Nothing "trim"] Nothing-> [("leading", StringLit "'" "'" " ")-> ,("from", Iden [Name Nothing "target_string"])])---> ]--> aggregates :: TestItem-> aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))-> [("count(*)",App [Name Nothing "count"] [Star])--> ,("sum(a order by a)"-> ,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]-> [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(all a)"-> ,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing)--> ,("count(distinct a)"-> ,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing)-> ]--> windowFunctions :: TestItem-> windowFunctions = Group "windowFunctions" $ map (uncurry (TestScalarExpr ansi2011))-> [("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing)-> ,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing)--> ,("max(a) over (partition by b)"-> ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing)--> ,("max(a) over (partition by b,c)"-> ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing)--> ,("sum(a) over (order by b)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []-> [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(a) over (order by b desc,c)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []-> [SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault-> ,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(a) over (partition by b order by c)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(a) over (partition by b order by c range unbounded preceding)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange UnboundedPreceding)--> ,("sum(a) over (partition by b order by c range 5 preceding)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))--> ,("sum(a) over (partition by b order by c range current row)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange Current)--> ,("sum(a) over (partition by b order by c rows 5 following)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRows $ Following (NumLit "5"))--> ,("sum(a) over (partition by b order by c range unbounded following)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange UnboundedFollowing)--> ,("sum(a) over (partition by b order by c \n\-> \range between 5 preceding and 5 following)"-> ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]-> [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameBetween FrameRange-> (Preceding (NumLit "5"))-> (Following (NumLit "5")))--> ]--> parens :: TestItem-> parens = Group "parens" $ map (uncurry (TestScalarExpr ansi2011))-> [("(a)", Parens (Iden [Name Nothing "a"]))-> ,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])))-> ]--> functionsWithReservedNames :: TestItem-> functionsWithReservedNames = Group "functionsWithReservedNames" $ map t-> ["abs"-> ,"char_length"-> ]-> where-> t fn = TestScalarExpr ansi2011 (fn ++ "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]-
− tools/Language/SQL/SimpleSQL/TableRefs.lhs
@@ -1,105 +0,0 @@--These are the tests for parsing focusing on the from part of query-expression--> module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax---> tableRefTests :: TestItem-> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))-> [("select a from t"-> ,ms [TRSimple [Name Nothing "t"]])--> ,("select a from f(a)"-> ,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])--> ,("select a from t,u"-> ,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]])--> ,("select a from s.t"-> ,ms [TRSimple [Name Nothing "s", Name Nothing "t"]])--these lateral queries make no sense but the syntax is valid--> ,("select a from lateral a"-> ,ms [TRLateral $ TRSimple [Name Nothing "a"]])--> ,("select a from lateral a,b"-> ,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]])--> ,("select a from a, lateral b"-> ,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]])--> ,("select a from a natural join lateral b"-> ,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner-> (TRLateral $ TRSimple [Name Nothing "b"])-> Nothing])--> ,("select a from lateral a natural join lateral b"-> ,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner-> (TRLateral $ TRSimple [Name Nothing "b"])-> Nothing])---> ,("select a from t inner join u on expr"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])-> (Just $ JoinOn $ Iden [Name Nothing "expr"])])--> ,("select a from t join u on expr"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])-> (Just $ JoinOn $ Iden [Name Nothing "expr"])])--> ,("select a from t left join u on expr"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"])-> (Just $ JoinOn $ Iden [Name Nothing "expr"])])--> ,("select a from t right join u on expr"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"])-> (Just $ JoinOn $ Iden [Name Nothing "expr"])])--> ,("select a from t full join u on expr"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"])-> (Just $ JoinOn $ Iden [Name Nothing "expr"])])--> ,("select a from t cross join u"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False-> JCross (TRSimple [Name Nothing "u"]) Nothing])--> ,("select a from t natural inner join u"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"])-> Nothing])--> ,("select a from t inner join u using(a,b)"-> ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])-> (Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])])--> ,("select a from (select a from t)"-> ,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]])--> ,("select a from t as u"-> ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])--> ,("select a from t u"-> ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])--> ,("select a from t u(b)"-> ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])])--> ,("select a from (t cross join u) as u"-> ,ms [TRAlias (TRParens $-> TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing)-> (Alias (Name Nothing "u") Nothing)])-> -- todo: not sure if the associativity is correct--> ,("select a from t cross join u cross join v",-> ms [TRJoin-> (TRJoin (TRSimple [Name Nothing "t"]) False-> JCross (TRSimple [Name Nothing "u"]) Nothing)-> False JCross (TRSimple [Name Nothing "v"]) Nothing])-> ]-> where-> ms f = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]-> ,qeFrom = f}
− tools/Language/SQL/SimpleSQL/TestTypes.lhs
@@ -1,37 +0,0 @@--This is the types used to define the tests as pure data. See the-Tests.lhs module for the 'interpreter'.--> module Language.SQL.SimpleSQL.TestTypes-> (TestItem(..)-> ,module Language.SQL.SimpleSQL.Dialect-> ) where--> import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Lex (Token)-> import Language.SQL.SimpleSQL.Dialect--TODO: maybe make the dialect args into [dialect], then each test-checks all the dialects mentioned work, and all the dialects not-mentioned give a parse error. Not sure if this will be too awkward due-to lots of tricky exceptions/variationsx.--> data TestItem = Group String [TestItem]-> | TestScalarExpr Dialect String ScalarExpr-> | TestQueryExpr Dialect String QueryExpr-> | TestStatement Dialect String Statement-> | TestStatements Dialect String [Statement]--this just checks the sql parses without error, mostly just a-intermediate when I'm too lazy to write out the parsed AST. These-should all be TODO to convert to a testqueryexpr test.--> | ParseQueryExpr Dialect String--check that the string given fails to parse--> | ParseQueryExprFails Dialect String-> | ParseScalarExprFails Dialect String-> | LexTest Dialect String [Token]-> | LexFails Dialect String-> deriving (Eq,Show)
− tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -1,166 +0,0 @@--This is the main tests module which exposes the test data plus the-Test.Framework tests. It also contains the code which converts the-test data to the Test.Framework tests.--> module Language.SQL.SimpleSQL.Tests-> (testData-> ,tests-> ,TestItem(..)-> ) where--> import qualified Test.Tasty as T-> import qualified Test.Tasty.HUnit as H--> --import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Pretty-> import Language.SQL.SimpleSQL.Parse-> import Language.SQL.SimpleSQL.Lex--> import Language.SQL.SimpleSQL.TestTypes--> import Language.SQL.SimpleSQL.FullQueries-> import Language.SQL.SimpleSQL.GroupBy-> import Language.SQL.SimpleSQL.Postgres-> import Language.SQL.SimpleSQL.QueryExprComponents-> import Language.SQL.SimpleSQL.QueryExprs-> import Language.SQL.SimpleSQL.TableRefs-> import Language.SQL.SimpleSQL.ScalarExprs-> import Language.SQL.SimpleSQL.Odbc-> import Language.SQL.SimpleSQL.Tpch-> import Language.SQL.SimpleSQL.LexerTests--> import Language.SQL.SimpleSQL.SQL2011Queries-> import Language.SQL.SimpleSQL.SQL2011AccessControl-> import Language.SQL.SimpleSQL.SQL2011Bits-> import Language.SQL.SimpleSQL.SQL2011DataManipulation-> import Language.SQL.SimpleSQL.SQL2011Schema--> import Language.SQL.SimpleSQL.MySQL-> import Language.SQL.SimpleSQL.Oracle-> import Language.SQL.SimpleSQL.CustomDialect--Order the tests to start from the simplest first. This is also the-order on the generated documentation.--> testData :: TestItem-> testData =-> Group "parserTest"-> [lexerTests-> ,scalarExprTests-> ,odbcTests-> ,queryExprComponentTests-> ,queryExprsTests-> ,tableRefTests-> ,groupByTests-> ,fullQueriesTests-> ,postgresTests-> ,tpchTests-> ,sql2011QueryTests-> ,sql2011DataManipulationTests-> ,sql2011SchemaTests-> ,sql2011AccessControlTests-> ,sql2011BitsTests-> ,mySQLTests-> ,oracleTests-> ,customDialectTests-> ]--> tests :: T.TestTree-> tests = itemToTest testData--> --runTests :: IO ()-> --runTests = void $ H.runTestTT $ itemToTest testData--> itemToTest :: TestItem -> T.TestTree-> itemToTest (Group nm ts) =-> T.testGroup nm $ map itemToTest ts-> itemToTest (TestScalarExpr d str expected) =-> toTest parseScalarExpr prettyScalarExpr d str expected-> itemToTest (TestQueryExpr d str expected) =-> toTest parseQueryExpr prettyQueryExpr d str expected-> itemToTest (TestStatement d str expected) =-> toTest parseStatement prettyStatement d str expected-> itemToTest (TestStatements d str expected) =-> toTest parseStatements prettyStatements d str expected-> itemToTest (ParseQueryExpr d str) =-> toPTest parseQueryExpr prettyQueryExpr d str--> itemToTest (ParseQueryExprFails d str) =-> toFTest parseQueryExpr prettyQueryExpr d str--> itemToTest (ParseScalarExprFails d str) =-> toFTest parseScalarExpr prettyScalarExpr d str--> itemToTest (LexTest d s ts) = makeLexerTest d s ts-> itemToTest (LexFails d s) = makeLexingFailsTest d s--> makeLexerTest :: Dialect -> String -> [Token] -> T.TestTree-> makeLexerTest d s ts = H.testCase s $ do-> let lx = either (error . show) id $ lexSQL d "" Nothing s-> H.assertEqual "" ts $ map snd lx-> let s' = prettyTokens d $ map snd lx-> H.assertEqual "pretty print" s s'--> makeLexingFailsTest :: Dialect -> String -> T.TestTree-> makeLexingFailsTest d s = H.testCase s $ do-> case lexSQL d "" Nothing s of-> Right x -> H.assertFailure $ "lexing should have failed: " ++ s ++ "\ngot: " ++ show x-> Left _ -> return ()---> toTest :: (Eq a, Show a) =>-> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)-> -> (Dialect -> a -> String)-> -> Dialect-> -> String-> -> a-> -> T.TestTree-> toTest parser pp d str expected = H.testCase str $ do-> let egot = parser d "" Nothing str-> case egot of-> Left e -> H.assertFailure $ peFormattedError e-> Right got -> do-> H.assertEqual "" expected got-> let str' = pp d got-> let egot' = parser d "" Nothing str'-> case egot' of-> Left e' -> H.assertFailure $ "pp roundtrip"-> ++ "\n" ++ str'-> ++ peFormattedError e'-> Right got' -> H.assertEqual-> ("pp roundtrip" ++ "\n" ++ str')-> expected got'--> toPTest :: (Eq a, Show a) =>-> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)-> -> (Dialect -> a -> String)-> -> Dialect-> -> String-> -> T.TestTree-> toPTest parser pp d str = H.testCase str $ do-> let egot = parser d "" Nothing str-> case egot of-> Left e -> H.assertFailure $ peFormattedError e-> Right got -> do-> let str' = pp d got-> let egot' = parser d "" Nothing str'-> case egot' of-> Left e' -> H.assertFailure $ "pp roundtrip "-> ++ "\n" ++ str' ++ "\n"-> ++ peFormattedError e'-> Right _got' -> return ()---> toFTest :: (Eq a, Show a) =>-> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)-> -> (Dialect -> a -> String)-> -> Dialect-> -> String-> -> T.TestTree-> toFTest parser _pp d str = H.testCase str $ do-> let egot = parser d "" Nothing str-> case egot of-> Left _e -> return ()-> Right _got ->-> H.assertFailure $ "parse didn't fail: " ++ show d ++ "\n" ++ str
− tools/Language/SQL/SimpleSQL/Tpch.lhs
@@ -1,683 +0,0 @@--Some tests for parsing the tpch queries--The changes made to the official syntax are:-1. replace the set rowcount with ansi standard fetch first n rows only-2. replace the create view, query, drop view sequence with a query- using a common table expression--> module Language.SQL.SimpleSQL.Tpch (tpchTests,tpchQueries) where--> import Language.SQL.SimpleSQL.TestTypes--> tpchTests :: TestItem-> tpchTests =-> Group "parse tpch"-> $ map (ParseQueryExpr ansi2011 . snd) tpchQueries--> tpchQueries :: [(String,String)]-> tpchQueries =-> [("Q1","\n\-> \select\n\-> \ l_returnflag,\n\-> \ l_linestatus,\n\-> \ sum(l_quantity) as sum_qty,\n\-> \ sum(l_extendedprice) as sum_base_price,\n\-> \ sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,\n\-> \ sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,\n\-> \ avg(l_quantity) as avg_qty,\n\-> \ avg(l_extendedprice) as avg_price,\n\-> \ avg(l_discount) as avg_disc,\n\-> \ count(*) as count_order\n\-> \from\n\-> \ lineitem\n\-> \where\n\-> \ l_shipdate <= date '1998-12-01' - interval '63' day (3)\n\-> \group by\n\-> \ l_returnflag,\n\-> \ l_linestatus\n\-> \order by\n\-> \ l_returnflag,\n\-> \ l_linestatus")-> ,("Q2","\n\-> \select\n\-> \ s_acctbal,\n\-> \ s_name,\n\-> \ n_name,\n\-> \ p_partkey,\n\-> \ p_mfgr,\n\-> \ s_address,\n\-> \ s_phone,\n\-> \ s_comment\n\-> \from\n\-> \ part,\n\-> \ supplier,\n\-> \ partsupp,\n\-> \ nation,\n\-> \ region\n\-> \where\n\-> \ p_partkey = ps_partkey\n\-> \ and s_suppkey = ps_suppkey\n\-> \ and p_size = 15\n\-> \ and p_type like '%BRASS'\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_regionkey = r_regionkey\n\-> \ and r_name = 'EUROPE'\n\-> \ and ps_supplycost = (\n\-> \ select\n\-> \ min(ps_supplycost)\n\-> \ from\n\-> \ partsupp,\n\-> \ supplier,\n\-> \ nation,\n\-> \ region\n\-> \ where\n\-> \ p_partkey = ps_partkey\n\-> \ and s_suppkey = ps_suppkey\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_regionkey = r_regionkey\n\-> \ and r_name = 'EUROPE'\n\-> \ )\n\-> \order by\n\-> \ s_acctbal desc,\n\-> \ n_name,\n\-> \ s_name,\n\-> \ p_partkey\n\-> \fetch first 100 rows only")-> ,("Q3","\n\-> \ select\n\-> \ l_orderkey,\n\-> \ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\-> \ o_orderdate,\n\-> \ o_shippriority\n\-> \ from\n\-> \ customer,\n\-> \ orders,\n\-> \ lineitem\n\-> \ where\n\-> \ c_mktsegment = 'MACHINERY'\n\-> \ and c_custkey = o_custkey\n\-> \ and l_orderkey = o_orderkey\n\-> \ and o_orderdate < date '1995-03-21'\n\-> \ and l_shipdate > date '1995-03-21'\n\-> \ group by\n\-> \ l_orderkey,\n\-> \ o_orderdate,\n\-> \ o_shippriority\n\-> \ order by\n\-> \ revenue desc,\n\-> \ o_orderdate\n\-> \ fetch first 10 rows only")-> ,("Q4","\n\-> \ select\n\-> \ o_orderpriority,\n\-> \ count(*) as order_count\n\-> \ from\n\-> \ orders\n\-> \ where\n\-> \ o_orderdate >= date '1996-03-01'\n\-> \ and o_orderdate < date '1996-03-01' + interval '3' month\n\-> \ and exists (\n\-> \ select\n\-> \ *\n\-> \ from\n\-> \ lineitem\n\-> \ where\n\-> \ l_orderkey = o_orderkey\n\-> \ and l_commitdate < l_receiptdate\n\-> \ )\n\-> \ group by\n\-> \ o_orderpriority\n\-> \ order by\n\-> \ o_orderpriority")-> ,("Q5","\n\-> \ select\n\-> \ n_name,\n\-> \ sum(l_extendedprice * (1 - l_discount)) as revenue\n\-> \ from\n\-> \ customer,\n\-> \ orders,\n\-> \ lineitem,\n\-> \ supplier,\n\-> \ nation,\n\-> \ region\n\-> \ where\n\-> \ c_custkey = o_custkey\n\-> \ and l_orderkey = o_orderkey\n\-> \ and l_suppkey = s_suppkey\n\-> \ and c_nationkey = s_nationkey\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_regionkey = r_regionkey\n\-> \ and r_name = 'EUROPE'\n\-> \ and o_orderdate >= date '1997-01-01'\n\-> \ and o_orderdate < date '1997-01-01' + interval '1' year\n\-> \ group by\n\-> \ n_name\n\-> \ order by\n\-> \ revenue desc")-> ,("Q6","\n\-> \ select\n\-> \ sum(l_extendedprice * l_discount) as revenue\n\-> \ from\n\-> \ lineitem\n\-> \ where\n\-> \ l_shipdate >= date '1997-01-01'\n\-> \ and l_shipdate < date '1997-01-01' + interval '1' year\n\-> \ and l_discount between 0.07 - 0.01 and 0.07 + 0.01\n\-> \ and l_quantity < 24")-> ,("Q7","\n\-> \ select\n\-> \ supp_nation,\n\-> \ cust_nation,\n\-> \ l_year,\n\-> \ sum(volume) as revenue\n\-> \ from\n\-> \ (\n\-> \ select\n\-> \ n1.n_name as supp_nation,\n\-> \ n2.n_name as cust_nation,\n\-> \ extract(year from l_shipdate) as l_year,\n\-> \ l_extendedprice * (1 - l_discount) as volume\n\-> \ from\n\-> \ supplier,\n\-> \ lineitem,\n\-> \ orders,\n\-> \ customer,\n\-> \ nation n1,\n\-> \ nation n2\n\-> \ where\n\-> \ s_suppkey = l_suppkey\n\-> \ and o_orderkey = l_orderkey\n\-> \ and c_custkey = o_custkey\n\-> \ and s_nationkey = n1.n_nationkey\n\-> \ and c_nationkey = n2.n_nationkey\n\-> \ and (\n\-> \ (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')\n\-> \ or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')\n\-> \ )\n\-> \ and l_shipdate between date '1995-01-01' and date '1996-12-31'\n\-> \ ) as shipping\n\-> \ group by\n\-> \ supp_nation,\n\-> \ cust_nation,\n\-> \ l_year\n\-> \ order by\n\-> \ supp_nation,\n\-> \ cust_nation,\n\-> \ l_year")-> ,("Q8","\n\-> \ select\n\-> \ o_year,\n\-> \ sum(case\n\-> \ when nation = 'IRAQ' then volume\n\-> \ else 0\n\-> \ end) / sum(volume) as mkt_share\n\-> \ from\n\-> \ (\n\-> \ select\n\-> \ extract(year from o_orderdate) as o_year,\n\-> \ l_extendedprice * (1 - l_discount) as volume,\n\-> \ n2.n_name as nation\n\-> \ from\n\-> \ part,\n\-> \ supplier,\n\-> \ lineitem,\n\-> \ orders,\n\-> \ customer,\n\-> \ nation n1,\n\-> \ nation n2,\n\-> \ region\n\-> \ where\n\-> \ p_partkey = l_partkey\n\-> \ and s_suppkey = l_suppkey\n\-> \ and l_orderkey = o_orderkey\n\-> \ and o_custkey = c_custkey\n\-> \ and c_nationkey = n1.n_nationkey\n\-> \ and n1.n_regionkey = r_regionkey\n\-> \ and r_name = 'MIDDLE EAST'\n\-> \ and s_nationkey = n2.n_nationkey\n\-> \ and o_orderdate between date '1995-01-01' and date '1996-12-31'\n\-> \ and p_type = 'STANDARD ANODIZED BRASS'\n\-> \ ) as all_nations\n\-> \ group by\n\-> \ o_year\n\-> \ order by\n\-> \ o_year")-> ,("Q9","\n\-> \ select\n\-> \ nation,\n\-> \ o_year,\n\-> \ sum(amount) as sum_profit\n\-> \ from\n\-> \ (\n\-> \ select\n\-> \ n_name as nation,\n\-> \ extract(year from o_orderdate) as o_year,\n\-> \ l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount\n\-> \ from\n\-> \ part,\n\-> \ supplier,\n\-> \ lineitem,\n\-> \ partsupp,\n\-> \ orders,\n\-> \ nation\n\-> \ where\n\-> \ s_suppkey = l_suppkey\n\-> \ and ps_suppkey = l_suppkey\n\-> \ and ps_partkey = l_partkey\n\-> \ and p_partkey = l_partkey\n\-> \ and o_orderkey = l_orderkey\n\-> \ and s_nationkey = n_nationkey\n\-> \ and p_name like '%antique%'\n\-> \ ) as profit\n\-> \ group by\n\-> \ nation,\n\-> \ o_year\n\-> \ order by\n\-> \ nation,\n\-> \ o_year desc")-> ,("Q10","\n\-> \ select\n\-> \ c_custkey,\n\-> \ c_name,\n\-> \ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\-> \ c_acctbal,\n\-> \ n_name,\n\-> \ c_address,\n\-> \ c_phone,\n\-> \ c_comment\n\-> \ from\n\-> \ customer,\n\-> \ orders,\n\-> \ lineitem,\n\-> \ nation\n\-> \ where\n\-> \ c_custkey = o_custkey\n\-> \ and l_orderkey = o_orderkey\n\-> \ and o_orderdate >= date '1993-12-01'\n\-> \ and o_orderdate < date '1993-12-01' + interval '3' month\n\-> \ and l_returnflag = 'R'\n\-> \ and c_nationkey = n_nationkey\n\-> \ group by\n\-> \ c_custkey,\n\-> \ c_name,\n\-> \ c_acctbal,\n\-> \ c_phone,\n\-> \ n_name,\n\-> \ c_address,\n\-> \ c_comment\n\-> \ order by\n\-> \ revenue desc\n\-> \ fetch first 20 rows only")-> ,("Q11","\n\-> \ select\n\-> \ ps_partkey,\n\-> \ sum(ps_supplycost * ps_availqty) as value\n\-> \ from\n\-> \ partsupp,\n\-> \ supplier,\n\-> \ nation\n\-> \ where\n\-> \ ps_suppkey = s_suppkey\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_name = 'CHINA'\n\-> \ group by\n\-> \ ps_partkey having\n\-> \ sum(ps_supplycost * ps_availqty) > (\n\-> \ select\n\-> \ sum(ps_supplycost * ps_availqty) * 0.0001000000\n\-> \ from\n\-> \ partsupp,\n\-> \ supplier,\n\-> \ nation\n\-> \ where\n\-> \ ps_suppkey = s_suppkey\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_name = 'CHINA'\n\-> \ )\n\-> \ order by\n\-> \ value desc")-> ,("Q12","\n\-> \ select\n\-> \ l_shipmode,\n\-> \ sum(case\n\-> \ when o_orderpriority = '1-URGENT'\n\-> \ or o_orderpriority = '2-HIGH'\n\-> \ then 1\n\-> \ else 0\n\-> \ end) as high_line_count,\n\-> \ sum(case\n\-> \ when o_orderpriority <> '1-URGENT'\n\-> \ and o_orderpriority <> '2-HIGH'\n\-> \ then 1\n\-> \ else 0\n\-> \ end) as low_line_count\n\-> \ from\n\-> \ orders,\n\-> \ lineitem\n\-> \ where\n\-> \ o_orderkey = l_orderkey\n\-> \ and l_shipmode in ('AIR', 'RAIL')\n\-> \ and l_commitdate < l_receiptdate\n\-> \ and l_shipdate < l_commitdate\n\-> \ and l_receiptdate >= date '1994-01-01'\n\-> \ and l_receiptdate < date '1994-01-01' + interval '1' year\n\-> \ group by\n\-> \ l_shipmode\n\-> \ order by\n\-> \ l_shipmode")-> ,("Q13","\n\-> \ select\n\-> \ c_count,\n\-> \ count(*) as custdist\n\-> \ from\n\-> \ (\n\-> \ select\n\-> \ c_custkey,\n\-> \ count(o_orderkey)\n\-> \ from\n\-> \ customer left outer join orders on\n\-> \ c_custkey = o_custkey\n\-> \ and o_comment not like '%pending%requests%'\n\-> \ group by\n\-> \ c_custkey\n\-> \ ) as c_orders (c_custkey, c_count)\n\-> \ group by\n\-> \ c_count\n\-> \ order by\n\-> \ custdist desc,\n\-> \ c_count desc")-> ,("Q14","\n\-> \ select\n\-> \ 100.00 * sum(case\n\-> \ when p_type like 'PROMO%'\n\-> \ then l_extendedprice * (1 - l_discount)\n\-> \ else 0\n\-> \ end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue\n\-> \ from\n\-> \ lineitem,\n\-> \ part\n\-> \ where\n\-> \ l_partkey = p_partkey\n\-> \ and l_shipdate >= date '1994-12-01'\n\-> \ and l_shipdate < date '1994-12-01' + interval '1' month")-> ,("Q15","\n\-> \ /*create view revenue0 (supplier_no, total_revenue) as\n\-> \ select\n\-> \ l_suppkey,\n\-> \ sum(l_extendedprice * (1 - l_discount))\n\-> \ from\n\-> \ lineitem\n\-> \ where\n\-> \ l_shipdate >= date '1995-06-01'\n\-> \ and l_shipdate < date '1995-06-01' + interval '3' month\n\-> \ group by\n\-> \ l_suppkey;*/\n\-> \ with\n\-> \ revenue0 as\n\-> \ (select\n\-> \ l_suppkey as supplier_no,\n\-> \ sum(l_extendedprice * (1 - l_discount)) as total_revenue\n\-> \ from\n\-> \ lineitem\n\-> \ where\n\-> \ l_shipdate >= date '1995-06-01'\n\-> \ and l_shipdate < date '1995-06-01' + interval '3' month\n\-> \ group by\n\-> \ l_suppkey)\n\-> \ select\n\-> \ s_suppkey,\n\-> \ s_name,\n\-> \ s_address,\n\-> \ s_phone,\n\-> \ total_revenue\n\-> \ from\n\-> \ supplier,\n\-> \ revenue0\n\-> \ where\n\-> \ s_suppkey = supplier_no\n\-> \ and total_revenue = (\n\-> \ select\n\-> \ max(total_revenue)\n\-> \ from\n\-> \ revenue0\n\-> \ )\n\-> \ order by\n\-> \ s_suppkey")-> ,("Q16","\n\-> \ select\n\-> \ p_brand,\n\-> \ p_type,\n\-> \ p_size,\n\-> \ count(distinct ps_suppkey) as supplier_cnt\n\-> \ from\n\-> \ partsupp,\n\-> \ part\n\-> \ where\n\-> \ p_partkey = ps_partkey\n\-> \ and p_brand <> 'Brand#15'\n\-> \ and p_type not like 'MEDIUM BURNISHED%'\n\-> \ and p_size in (39, 26, 18, 45, 19, 1, 3, 9)\n\-> \ and ps_suppkey not in (\n\-> \ select\n\-> \ s_suppkey\n\-> \ from\n\-> \ supplier\n\-> \ where\n\-> \ s_comment like '%Customer%Complaints%'\n\-> \ )\n\-> \ group by\n\-> \ p_brand,\n\-> \ p_type,\n\-> \ p_size\n\-> \ order by\n\-> \ supplier_cnt desc,\n\-> \ p_brand,\n\-> \ p_type,\n\-> \ p_size")-> ,("Q17","\n\-> \ select\n\-> \ sum(l_extendedprice) / 7.0 as avg_yearly\n\-> \ from\n\-> \ lineitem,\n\-> \ part\n\-> \ where\n\-> \ p_partkey = l_partkey\n\-> \ and p_brand = 'Brand#52'\n\-> \ and p_container = 'JUMBO CAN'\n\-> \ and l_quantity < (\n\-> \ select\n\-> \ 0.2 * avg(l_quantity)\n\-> \ from\n\-> \ lineitem\n\-> \ where\n\-> \ l_partkey = p_partkey\n\-> \ )")-> ,("Q18","\n\-> \ select\n\-> \ c_name,\n\-> \ c_custkey,\n\-> \ o_orderkey,\n\-> \ o_orderdate,\n\-> \ o_totalprice,\n\-> \ sum(l_quantity)\n\-> \ from\n\-> \ customer,\n\-> \ orders,\n\-> \ lineitem\n\-> \ where\n\-> \ o_orderkey in (\n\-> \ select\n\-> \ l_orderkey\n\-> \ from\n\-> \ lineitem\n\-> \ group by\n\-> \ l_orderkey having\n\-> \ sum(l_quantity) > 313\n\-> \ )\n\-> \ and c_custkey = o_custkey\n\-> \ and o_orderkey = l_orderkey\n\-> \ group by\n\-> \ c_name,\n\-> \ c_custkey,\n\-> \ o_orderkey,\n\-> \ o_orderdate,\n\-> \ o_totalprice\n\-> \ order by\n\-> \ o_totalprice desc,\n\-> \ o_orderdate\n\-> \ fetch first 100 rows only")-> ,("Q19","\n\-> \ select\n\-> \ sum(l_extendedprice* (1 - l_discount)) as revenue\n\-> \ from\n\-> \ lineitem,\n\-> \ part\n\-> \ where\n\-> \ (\n\-> \ p_partkey = l_partkey\n\-> \ and p_brand = 'Brand#43'\n\-> \ and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')\n\-> \ and l_quantity >= 3 and l_quantity <= 3 + 10\n\-> \ and p_size between 1 and 5\n\-> \ and l_shipmode in ('AIR', 'AIR REG')\n\-> \ and l_shipinstruct = 'DELIVER IN PERSON'\n\-> \ )\n\-> \ or\n\-> \ (\n\-> \ p_partkey = l_partkey\n\-> \ and p_brand = 'Brand#25'\n\-> \ and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')\n\-> \ and l_quantity >= 10 and l_quantity <= 10 + 10\n\-> \ and p_size between 1 and 10\n\-> \ and l_shipmode in ('AIR', 'AIR REG')\n\-> \ and l_shipinstruct = 'DELIVER IN PERSON'\n\-> \ )\n\-> \ or\n\-> \ (\n\-> \ p_partkey = l_partkey\n\-> \ and p_brand = 'Brand#24'\n\-> \ and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')\n\-> \ and l_quantity >= 22 and l_quantity <= 22 + 10\n\-> \ and p_size between 1 and 15\n\-> \ and l_shipmode in ('AIR', 'AIR REG')\n\-> \ and l_shipinstruct = 'DELIVER IN PERSON'\n\-> \ )")-> ,("Q20","\n\-> \ select\n\-> \ s_name,\n\-> \ s_address\n\-> \ from\n\-> \ supplier,\n\-> \ nation\n\-> \ where\n\-> \ s_suppkey in (\n\-> \ select\n\-> \ ps_suppkey\n\-> \ from\n\-> \ partsupp\n\-> \ where\n\-> \ ps_partkey in (\n\-> \ select\n\-> \ p_partkey\n\-> \ from\n\-> \ part\n\-> \ where\n\-> \ p_name like 'lime%'\n\-> \ )\n\-> \ and ps_availqty > (\n\-> \ select\n\-> \ 0.5 * sum(l_quantity)\n\-> \ from\n\-> \ lineitem\n\-> \ where\n\-> \ l_partkey = ps_partkey\n\-> \ and l_suppkey = ps_suppkey\n\-> \ and l_shipdate >= date '1994-01-01'\n\-> \ and l_shipdate < date '1994-01-01' + interval '1' year\n\-> \ )\n\-> \ )\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_name = 'VIETNAM'\n\-> \ order by\n\-> \ s_name")-> ,("Q21","\n\-> \ select\n\-> \ s_name,\n\-> \ count(*) as numwait\n\-> \ from\n\-> \ supplier,\n\-> \ lineitem l1,\n\-> \ orders,\n\-> \ nation\n\-> \ where\n\-> \ s_suppkey = l1.l_suppkey\n\-> \ and o_orderkey = l1.l_orderkey\n\-> \ and o_orderstatus = 'F'\n\-> \ and l1.l_receiptdate > l1.l_commitdate\n\-> \ and exists (\n\-> \ select\n\-> \ *\n\-> \ from\n\-> \ lineitem l2\n\-> \ where\n\-> \ l2.l_orderkey = l1.l_orderkey\n\-> \ and l2.l_suppkey <> l1.l_suppkey\n\-> \ )\n\-> \ and not exists (\n\-> \ select\n\-> \ *\n\-> \ from\n\-> \ lineitem l3\n\-> \ where\n\-> \ l3.l_orderkey = l1.l_orderkey\n\-> \ and l3.l_suppkey <> l1.l_suppkey\n\-> \ and l3.l_receiptdate > l3.l_commitdate\n\-> \ )\n\-> \ and s_nationkey = n_nationkey\n\-> \ and n_name = 'INDIA'\n\-> \ group by\n\-> \ s_name\n\-> \ order by\n\-> \ numwait desc,\n\-> \ s_name\n\-> \ fetch first 100 rows only")-> ,("Q22","\n\-> \ select\n\-> \ cntrycode,\n\-> \ count(*) as numcust,\n\-> \ sum(c_acctbal) as totacctbal\n\-> \ from\n\-> \ (\n\-> \ select\n\-> \ substring(c_phone from 1 for 2) as cntrycode,\n\-> \ c_acctbal\n\-> \ from\n\-> \ customer\n\-> \ where\n\-> \ substring(c_phone from 1 for 2) in\n\-> \ ('41', '28', '39', '21', '24', '29', '44')\n\-> \ and c_acctbal > (\n\-> \ select\n\-> \ avg(c_acctbal)\n\-> \ from\n\-> \ customer\n\-> \ where\n\-> \ c_acctbal > 0.00\n\-> \ and substring(c_phone from 1 for 2) in\n\-> \ ('41', '28', '39', '21', '24', '29', '44')\n\-> \ )\n\-> \ and not exists (\n\-> \ select\n\-> \ *\n\-> \ from\n\-> \ orders\n\-> \ where\n\-> \ o_custkey = c_custkey\n\-> \ )\n\-> \ ) as custsale\n\-> \ group by\n\-> \ cntrycode\n\-> \ order by\n\-> \ cntrycode")-> ]
− tools/RunTests.lhs
@@ -1,8 +0,0 @@---> import Test.Tasty--> import Language.SQL.SimpleSQL.Tests--> main :: IO ()-> main = defaultMain tests
− tools/SimpleSqlParserTool.lhs
@@ -1,93 +0,0 @@--Simple command line tool to experiment with simple-sql-parser--Commands:--parse: parse sql from file, stdin or from command line-lex: lex sql same-indent: parse then pretty print sql--> {-# LANGUAGE TupleSections #-}-> import System.Environment-> import Control.Monad-> import Data.Maybe-> import System.Exit-> import Data.List-> import Text.Show.Pretty-> --import Control.Applicative--> import Language.SQL.SimpleSQL.Pretty-> import Language.SQL.SimpleSQL.Parse-> import Language.SQL.SimpleSQL.Lex---> main :: IO ()-> main = do-> args <- getArgs-> case args of-> [] -> do-> showHelp $ Just "no command given"-> (c:as) -> do-> let cmd = lookup c commands-> maybe (showHelp (Just "command not recognised"))-> (\(_,cmd') -> cmd' as)-> cmd--> commands :: [(String, (String,[String] -> IO ()))]-> commands =-> [("help", helpCommand)-> ,("parse", parseCommand)-> ,("lex", lexCommand)-> ,("indent", indentCommand)]--> showHelp :: Maybe String -> IO ()-> showHelp msg = do-> maybe (return ()) (\e -> putStrLn $ "Error: " ++ e) msg-> putStrLn "Usage:\n SimpleSqlParserTool command args"-> forM_ commands $ \(c, (h,_)) -> do-> putStrLn $ c ++ "\t" ++ h-> when (isJust msg) $ exitFailure--> helpCommand :: (String,[String] -> IO ())-> helpCommand =-> ("show help for this progam", \_ -> showHelp Nothing)--> getInput :: [String] -> IO (FilePath,String)-> getInput as =-> case as of-> ["-"] -> ("",) <$> getContents-> ("-c":as') -> return ("", unwords as')-> [filename] -> (filename,) <$> readFile filename-> _ -> showHelp (Just "arguments not recognised") >> error ""--> parseCommand :: (String,[String] -> IO ())-> parseCommand =-> ("parse SQL from file/stdin/command line (use -c to parse from command line)"-> ,\args -> do-> (f,src) <- getInput args-> either (error . peFormattedError)-> (putStrLn . ppShow)-> $ parseStatements ansi2011 f Nothing src-> )--> lexCommand :: (String,[String] -> IO ())-> lexCommand =-> ("lex SQL from file/stdin/command line (use -c to parse from command line)"-> ,\args -> do-> (f,src) <- getInput args-> either (error . peFormattedError)-> (putStrLn . intercalate ",\n" . map show)-> $ lexSQL ansi2011 f Nothing src-> )---> indentCommand :: (String,[String] -> IO ())-> indentCommand =-> ("parse then pretty print SQL from file/stdin/command line (use -c to parse from command line)"-> ,\args -> do-> (f,src) <- getInput args-> either (error . peFormattedError)-> (putStrLn . prettyStatements ansi2011)-> $ parseStatements ansi2011 f Nothing src--> )