simple-sql-parser 0.4.4 → 0.8.0
raw patch · 57 files changed
Files
- LICENSE +1/−1
- Language/SQL/SimpleSQL/Combinators.lhs +0/−109
- Language/SQL/SimpleSQL/Dialect.hs +564/−0
- Language/SQL/SimpleSQL/Errors.lhs +0/−51
- Language/SQL/SimpleSQL/Lex.hs +1034/−0
- Language/SQL/SimpleSQL/Parse.hs +2487/−0
- Language/SQL/SimpleSQL/Parser.lhs +0/−2018
- Language/SQL/SimpleSQL/Pretty.hs +895/−0
- Language/SQL/SimpleSQL/Pretty.lhs +0/−456
- Language/SQL/SimpleSQL/Syntax.hs +774/−0
- Language/SQL/SimpleSQL/Syntax.lhs +0/−394
- README +2/−2
- Setup.hs +0/−2
- changelog +79/−4
- examples/SimpleSQLParserTool.hs +106/−0
- simple-sql-parser.cabal +69/−63
- tests/Language/SQL/SimpleSQL/CreateIndex.hs +22/−0
- tests/Language/SQL/SimpleSQL/CustomDialect.hs +32/−0
- tests/Language/SQL/SimpleSQL/EmptyStatement.hs +28/−0
- tests/Language/SQL/SimpleSQL/ErrorMessages.hs +697/−0
- tests/Language/SQL/SimpleSQL/Expectations.hs +61/−0
- tests/Language/SQL/SimpleSQL/FullQueries.hs +43/−0
- tests/Language/SQL/SimpleSQL/GroupBy.hs +248/−0
- tests/Language/SQL/SimpleSQL/LexerTests.hs +428/−0
- tests/Language/SQL/SimpleSQL/MySQL.hs +39/−0
- tests/Language/SQL/SimpleSQL/Odbc.hs +60/−0
- tests/Language/SQL/SimpleSQL/Oracle.hs +32/−0
- tests/Language/SQL/SimpleSQL/Postgres.hs +284/−0
- tests/Language/SQL/SimpleSQL/QueryExprComponents.hs +228/−0
- tests/Language/SQL/SimpleSQL/QueryExprParens.hs +47/−0
- tests/Language/SQL/SimpleSQL/QueryExprs.hs +31/−0
- tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs +304/−0
- tests/Language/SQL/SimpleSQL/SQL2011Bits.hs +226/−0
- tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs +560/−0
- tests/Language/SQL/SimpleSQL/SQL2011Queries.hs +4508/−0
- tests/Language/SQL/SimpleSQL/SQL2011Schema.hs +2239/−0
- tests/Language/SQL/SimpleSQL/ScalarExprs.hs +436/−0
- tests/Language/SQL/SimpleSQL/TableRefs.hs +111/−0
- tests/Language/SQL/SimpleSQL/TestRunners.hs +92/−0
- tests/Language/SQL/SimpleSQL/TestTypes.hs +56/−0
- tests/Language/SQL/SimpleSQL/Tests.hs +98/−0
- tests/Language/SQL/SimpleSQL/Tpch.hs +690/−0
- tests/RunTests.hs +9/−0
- tools/Language/SQL/SimpleSQL/FullQueries.lhs +0/−39
- tools/Language/SQL/SimpleSQL/GroupBy.lhs +0/−235
- tools/Language/SQL/SimpleSQL/MySQL.lhs +0/−40
- tools/Language/SQL/SimpleSQL/Postgres.lhs +0/−274
- tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs +0/−209
- tools/Language/SQL/SimpleSQL/QueryExprs.lhs +0/−18
- tools/Language/SQL/SimpleSQL/SQL2011.lhs +0/−4309
- tools/Language/SQL/SimpleSQL/TableRefs.lhs +0/−105
- tools/Language/SQL/SimpleSQL/TestTypes.lhs +0/−31
- tools/Language/SQL/SimpleSQL/Tests.lhs +0/−132
- tools/Language/SQL/SimpleSQL/Tpch.lhs +0/−683
- tools/Language/SQL/SimpleSQL/ValueExprs.lhs +0/−406
- tools/RunTests.lhs +0/−8
- tools/SQLIndent.lhs +0/−17
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013, Jake Wheat+Copyright 2013 - 2024, Jake Wheat and the simple-sql-parser contributors. All rights reserved.
− Language/SQL/SimpleSQL/Combinators.lhs
@@ -1,109 +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 ((<$>), (<*>), (<**>), pure, Applicative)-> import Text.Parsec (option,many)-> import Text.Parsec.Prim (Parsec)--> type Parser s = Parsec String s--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 -> Parser s a) -> a -> Parser 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--> (<??>) :: Parser s a -> Parser s (a -> a) -> Parser 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.--> (<??.>) :: Parser s (a -> a) -> Parser s (a -> a) -> Parser 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--> (<??*>) :: Parser s a -> Parser s (a -> a) -> Parser 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,564 @@+++-- 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+ -- | allow marking tables as "without rowid"+ ,diWithoutRowidTables :: Bool+ -- | allow omitting types for columns+ ,diOptionalColumnTypes :: Bool+ -- | allow mixing in DEFAULT clauses with other constraints+ ,diDefaultClausesAsConstraints :: 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+ ,diWithoutRowidTables = False+ ,diOptionalColumnTypes = False+ ,diDefaultClausesAsConstraints = 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/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,1034 @@++{-+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+ ,hidden+ ,setErrorOffset++ ,choice+ ,satisfy+ ,takeWhileP+ ,takeWhile1P+ ,eof+ ,many+ ,try+ ,option+ ,(<|>)+ ,notFollowedBy+ ,lookAhead+ ,match+ ,optional+ ,label+ ,chunk+ ,region+ ,anySingle+ )+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 Data.Char+ (isAlphaNum+ ,isAlpha+ ,isSpace+ ,isDigit+ )+import Control.Monad (void)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Maybe (fromMaybe)+--import Text.Megaparsec.Debug (dbg)++------------------------------------------------------------------------------++-- 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+ -- | Used for generating better error messages when using the+ -- output of the lexer in a parser+ | InvalidToken Text+ deriving (Eq,Show,Ord)++------------------------------------------------------------------------------++-- main api functions++-- | Lex some SQL to a list of tokens. The invalid token setting+-- changes the behaviour so that if there's a parse error at the start+-- of parsing an invalid token, it adds a final InvalidToken with the+-- character to the result then stop parsing. This can then be used to+-- produce a parse error with more context in the parser. Parse errors+-- within tokens still produce Left errors.+lexSQLWithPositions+ :: Dialect+ -- ^ dialect of SQL to use+ -> Bool+ -- ^ produce InvalidToken+ -> 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 pit fn p src = myParse fn p (tokens dialect pit) src++-- | Lex some SQL to a list of tokens.+lexSQL+ :: Dialect+ -- ^ dialect of SQL to use+ -> Bool+ -- ^ produce InvalidToken, see lexSQLWithPositions+ -> 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 pit fn p src =+ map tokenVal <$> lexSQLWithPositions dialect pit 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+prettyToken _ (InvalidToken t) = t++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 =+ withPos $ hidden $ choice $+ [sqlString d+ ,identifier d+ ,lineComment d+ ,blockComment d+ ,sqlNumber d+ ,positionalArg d+ ,dontParseEndBlockComment d+ ,prefixedVariable d+ ,symbol d+ ,sqlWhitespace d]++--fakeSourcePos :: SourcePos+--fakeSourcePos = SourcePos "" (mkPos 1) (mkPos 1)++--------------------------------------++-- position and error helpers++withPos :: Parser a -> Parser (WithPos a)+withPos p = do+ sp <- getSourcePos+ off <- getOffset+ a <- p+ off1 <- getOffset+ ep <- getSourcePos+ pure $ WithPos sp ep (off1 - off) a++{-++TODO: extend this idea, to recover to parsing regular tokens after an+invalid one. This can then support resumption after error in the parser.+This would also need something similar being done for parse errors+within lexical tokens.++-}+invalidToken :: Dialect -> Parser (WithPos Token)+invalidToken _ =+ withPos $ (hidden eof *> fail "") <|> (InvalidToken . T.singleton <$> anySingle)++tokens :: Dialect -> Bool -> Parser [WithPos Token]+tokens d pit = do+ x <- many (sqlToken d)+ if pit+ then choice [x <$ hidden eof+ ,(\y -> x ++ [y]) <$> hidden (invalidToken d)]+ else x <$ hidden eof++--------------------------------------++{-+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 =+ (if (diDollarString d)+ then (dollarString <|>)+ else id) csString <|> normalString+ where+ dollarString = do+ -- use try because of ambiguity with symbols and with+ -- positional arg+ delim <- fstMatch (try (char '$' *> hoptional_ identifierString <* char '$'))+ let moreDollarString =+ label (T.unpack delim) $ takeWhileP_ Nothing (/='$') *> checkDollar+ checkDollar = label (T.unpack delim) $ + choice+ [lookAhead (chunk_ delim) *> pure () -- would be nice not to parse it twice?+ -- but makes the whole match trick much less neat+ ,char_ '$' *> moreDollarString]+ str <- fstMatch moreDollarString+ chunk_ delim+ pure $ SqlString delim delim str+ lq = label "'" $ char_ '\''+ normalString = SqlString "'" "'" <$> (lq *> normalStringSuffix False)+ normalStringSuffix allowBackslash = label "'" $ do+ let regularChar = if allowBackslash+ then (\x -> x /= '\'' && x /='\\')+ else (\x -> x /= '\'')+ nonQuoteStringChar = takeWhileP_ Nothing regularChar+ nonRegularContinue = + (hchunk_ "''" <|> hchunk_ "\\'" <|> hchar_ '\\')+ moreChars = nonQuoteStringChar+ *> (option () (nonRegularContinue *> moreChars))+ fstMatch moreChars <* lq+ + -- 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]+ ++ [mySqlQuotedIden | diBackquotedIden d]+ ++ [sqlServerQuotedIden | diSquareBracketQuotedIden d]+ where+ regularIden = Identifier Nothing <$> identifierString+ quotedIden = Identifier (Just ("\"","\"")) <$> qiden+ failEmptyIden c = failOnThis (char_ c) "empty identifier"+ mySqlQuotedIden =+ Identifier (Just ("`","`")) <$>+ (char_ '`' *>+ (failEmptyIden '`'+ <|> (takeWhile1P Nothing (/='`') <* char_ '`')))+ sqlServerQuotedIden =+ Identifier (Just ("[","]")) <$>+ (char_ '[' *>+ (failEmptyIden ']'+ <|> (takeWhileP Nothing (`notElemChar` "[]")+ <* choice [char_ ']'+ -- should probably do this error message as+ -- a proper unexpected message+ ,failOnThis (char_ '[') "unexpected ["])))+ -- 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 "&"))+ <*> qiden+ where f x = Just (T.cons x "&\"", "\"")+ qiden =+ char_ '"' *> (failEmptyIden '"' <|> fstMatch moreQIden <* char_ '"')+ moreQIden =+ label "\""+ (takeWhileP_ Nothing (/='"')+ *> hoptional_ (chunk "\"\"" *> moreQIden))++identifierString :: Parser Text+identifierString = label "identifier" $ do+ c <- satisfy isFirstLetter+ choice+ [T.cons c <$> takeWhileP Nothing isIdentifierChar+ ,pure $ T.singleton c]+ where+ isFirstLetter c = c == '_' || isAlpha c++isIdentifierChar :: Char -> Bool+isIdentifierChar c = c == '_' || isAlphaNum c++--------------------------------------++lineComment :: Dialect -> Parser Token+lineComment _ = LineComment <$> fstMatch (do+ hidden (string_ "--")+ takeWhileP_ Nothing (/='\n')+ -- can you optionally read the \n to terminate the takewhilep without reparsing it?+ hoptional_ $ char_ '\n')++--------------------------------------++-- 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 _ = BlockComment <$> fstMatch bc+ where+ bc = chunk_ "/*" *> moreBlockChars+ regularBlockCommentChars = label "*/" $+ takeWhileP_ Nothing (\x -> x /= '*' && x /= '/')+ continueBlockComment = label "*/" (char_ '*' <|> char_ '/') *> moreBlockChars+ endComment = label "*/" $ chunk_ "*/"+ moreBlockChars = label "*/" $+ regularBlockCommentChars+ *> (endComment+ <|> (label "*/" bc *> moreBlockChars) -- nest+ <|> continueBlockComment)++{-+This is to improve user experience: provide an error if we see */+outside a comment. This could potentially break postgres ops with */+in them (it is not sensible to use operators that contain this as a+substring). In other cases, the user should write * / instead (I can't+think of any cases when this would be valid syntax).+-}++dontParseEndBlockComment :: Dialect -> Parser Token+dontParseEndBlockComment _ =+ failOnThis (chunk_ "*/") "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 <$> fstMatch+ ((numStartingWithDigits <|> numStartingWithDot)+ *> hoptional_ expo *> trailingCheck)+ where+ numStartingWithDigits = digits_ *> hoptional_ (safeDot *> hoptional_ digits_)+ -- use try, so we don't commit to a number when there's a . with no following digit+ numStartingWithDot = try (safeDot *> digits_)+ expo = (char_ 'e' <|> char_ 'E') *> optional_ (char_ '-' <|> char_ '+') *> digits_+ digits_ = label "digits" $ takeWhile1P_ Nothing isDigit+ -- if there's a '..' next to the number, and it's a dialect that has .. as a+ -- lexical token, parse what we have so far and leave the dots in the chamber+ -- otherwise, give an error+ safeDot =+ if diPostgresSymbols d+ then try (char_ '.' <* notFollowedBy (char_ '.'))+ else char_ '.' <* notFollowedBy (char_ '.')+ -- additional check to give an error if the number is immediately+ -- followed by e, E or . with an exception for .. if this symbol is supported+ trailingCheck =+ if diPostgresSymbols d+ then -- special case to allow e.g. 1..2+ void (lookAhead $ hidden $ chunk_ "..")+ <|> void (notFollowedBy (oneOf "eE."))+ else notFollowedBy (oneOf "eE.")++digits :: Parser Text+digits = label "digits" $ takeWhile1P Nothing isDigit++--------------------------------------++positionalArg :: Dialect -> Parser Token+positionalArg d =+ -- use try to avoid ambiguities with other syntax which starts with dollar+ choice [PositionalArg <$>+ try (char_ '$' *> (read . T.unpack <$> digits)) | diPositionalArg d]++--------------------------------------++-- 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]+ ++ [PrefixedVariable <$> char '@' <*> identifierString | diAtIdentifier d]+ ++ [PrefixedVariable <$> char '#' <*> identifierString | diHashIdentifier d]++--------------------------------------++{-+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 Nothing (=='.')]+ 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 Nothing isSpace++----------------------------------------------------------------------------++-- parser helpers++char_ :: Char -> Parser ()+char_ = void . char++hchar_ :: Char -> Parser ()+hchar_ = void . hidden . 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])++fstMatch :: Parser () -> Parser Text+fstMatch x = fst <$> match x++hoptional_ :: Parser a -> Parser ()+hoptional_ = void . hoptional++hoptional :: Parser a -> Parser (Maybe a)+hoptional = hidden . optional++optional_ :: Parser a -> Parser ()+optional_ = void . optional++--hoption :: a -> Parser a -> Parser a+--hoption a p = hidden $ option a p++takeWhileP_ :: Maybe String -> (Char -> Bool) -> Parser ()+takeWhileP_ m p = void $ takeWhileP m p++takeWhile1P_ :: Maybe String -> (Char -> Bool) -> Parser ()+takeWhile1P_ m p = void $ takeWhile1P m p++chunk_ :: Text -> Parser ()+chunk_ = void . chunk++hchunk_ :: Text -> Parser ()+hchunk_ = void . hidden . chunk++failOnThis :: Parser () -> Text -> Parser a+failOnThis p msg = do+ o <- getOffset+ hidden p+ region (setErrorOffset o) $ fail $ T.unpack msg++----------------------------------------------------------------------------+++{-+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+ -- I have no idea what all this is doing+ reachOffset o _x@(M.PosState {..}) =+ ( Just $ actualLine+ , PosState+ { pstateInput = SQLStream+ { sqlStreamInput = postStr+ , unSQLStream = post+ }+ , pstateOffset = max pstateOffset o+ , pstateSourcePos = newSourcePos+ , pstateTabWidth = pstateTabWidth+ , pstateLinePrefix = prefix+ }+ )+ where+ maybeitsthefullsource = sqlStreamInput pstateInput+ targetLineNo = M.unPos $ sourceLine newSourcePos+ actualLine = case drop (targetLineNo - 1) $ lines maybeitsthefullsource of+ (x:_) -> x+ [] -> "<empty line>"+ 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++pxy :: Proxy SQLStream+pxy = Proxy++showMyToken :: Token -> String+-- todo: how to do this properly?+showMyToken = T.unpack . prettyToken ansi2011
+ Language/SQL/SimpleSQL/Parse.hs view
@@ -0,0 +1,2487 @@++{-+= 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+ ,hidden+ ,failure+ ,ErrorItem(..)++ ,(<|>)+ ,token+ ,choice+ ,eof+ ,try+ ,sepBy+ ,sepBy1+ ,optional+ ,option+ ,some+ ,many+ ,between+ ,lookAhead+ )+import qualified Control.Monad.Combinators.Expr as E+import qualified Control.Monad.Permutations as P+import qualified Text.Megaparsec as M++import Control.Monad.Reader+ (Reader+ ,runReader+ ,ask+ ,asks+ )++import qualified Data.Set as Set+import qualified Data.List.NonEmpty as NE+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, fromMaybe)+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+--import Text.Megaparsec.Debug (dbg)+import Text.Read (readMaybe)++------------------------------------------------------------------------------++-- = 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 True f p src+ either (Left . ParseError) Right $+ runReader (runParserT (parser <* (hidden 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 :: Text -> Parser Name+name lbl = label lbl $ do+ bl <- askDialect diKeywords+ uncurry Name <$> identifierTok bl++-- todo: replace (:[]) with a named function all over++names :: Text -> Parser [Name]+names lbl =+ label lbl (reverse <$> (((:[]) <$> name lbl) `chainrSuffix` 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 ((:) <$> (hidden (symbol "." *> name lbl)))++{-+= 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.++the hideArg is used when the typename is used as part of a typed+literal expression, to hide what comes after the paren in+'typename('. This is so 'arbitrary_fn(' gives an 'expecting expression',+instead of 'expecting expression or number', which is odd.++-}++typeName :: Parser TypeName+typeName = typeName' False++typeName' :: Bool -> Parser TypeName+typeName' hideArg =+ label "typename" (+ (rowTypeName <|> intervalTypeName <|> otherTypeName)+ `chainrSuffix` tnSuffix)+ where+ rowTypeName =+ RowTypeName <$> (hidden (keyword_ "row") *> parens (commaSep1 rowField))+ rowField = (,) <$> name "type name" <*> typeName+ ----------------------------+ intervalTypeName =+ hidden (keyword_ "interval") *>+ (uncurry IntervalTypeName <$> intervalQualifier)+ ----------------------------+ otherTypeName =+ nameOfType <**>+ (typeNameWithParens+ <|> pure Nothing <**> (hidden timeTypeName <|> hidden charTypeName)+ <|> pure TypeName)+ nameOfType = reservedTypeNames <|> names "type name"+ charTypeName = charSet <**> (option [] tcollate <**> pure (flip4 CharTypeName))+ <|> pure [] <**> (tcollate <**> pure (flip4 CharTypeName))+ typeNameWithParens =+ (hidden openParen *> (if hideArg then hidden unsignedInteger else unsignedInteger))+ <**> (closeParen *> hidden precMaybeSuffix+ <|> hidden (precScaleTypeName <|> precLengthTypeName) <* closeParen)+ precMaybeSuffix = (. Just) <$> (timeTypeName <|> charTypeName)+ <|> pure (flip PrecTypeName)+ precScaleTypeName =+ (hidden comma *> (if hideArg then hidden unsignedInteger else unsignedInteger))+ <**> pure (flip3 PrecScaleTypeName)+ precLengthTypeName =+ Just <$> lobPrecSuffix+ <**> (optional lobUnits <**> pure (flip4 PrecLengthTypeName))+ <|> pure Nothing <**> ((Just <$> lobUnits) <**> pure (flip4 PrecLengthTypeName))+ timeTypeName = tz <**> pure (flip3 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 "character set name"+ tcollate = keyword_ "collate" *> names "collation name"+ ----------------------------+ tnSuffix = multiset <|> array+ multiset = MultisetTypeName <$ keyword_ "multiset"+ array = keyword_ "array" *>+ (optional (brackets unsignedInteger) <**> pure (flip 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 makes an attempt to not parse star in+most contexts, to provide better experience when the user makes a mistake+in an expression containing * meaning multiple. It will parse a *+at the top level of a select item, or in arg in a app argument list.+-}++star :: Parser ScalarExpr+star =+ hidden $ choice+ [Star <$ symbol "*"+ -- much easier to use try here than to left factor where+ -- this is allowed and not allowed+ ,try (QStar <$> (names "qualified star" <* symbol "." <* 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+ <*> hoptional (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+ -- no parens here used for nested parens expressions+ -- this could be fixed to be general with some refactoring, but at+ -- the moment, you can't use additional redundant parens in a+ -- subqueryexpr+ [SubQueryExpr SqSq <$> queryExprNoParens+ ,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 "sequence generator name"++{-+=== 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 =+ label "interval literal" $ try (keyword_ "interval" >> do+ s <- hoptional $ choice [Plus <$ symbol_ "+"+ ,Minus <$ symbol_ "-"]+ lit <- singleQuotesOnlyStringTok+ q <- hoptional 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: try reversing these+ -- then if it parses as a typename as part of a typed literal+ -- and not a regularapplike, then you'll get a better error message+ try typedLiteral <|> regularAppLike+ where+ -- parse regular iden or app+ -- if it could potentially be a typed literal typename 'literaltext'+ -- optionally try to parse that+ regularAppLike = do+ e <- (keywordFunctionOrIden+ <|> (names "identifier" <**> (hidden app <|> pure Iden)))+ let getInt s = readMaybe (T.unpack s)+ case e of+ Iden nm -> tryTypedLiteral (TypeName nm) <|> pure e+ App nm [NumLit prec]+ | Just prec' <- getInt prec ->+ tryTypedLiteral (PrecTypeName nm prec') <|> pure e+ App nm [NumLit prec,NumLit scale]+ | Just prec' <- getInt prec+ , Just scale' <- getInt scale ->+ tryTypedLiteral (PrecScaleTypeName nm prec' scale') <|> pure e+ _ -> pure e+ tryTypedLiteral tn =+ TypedLit tn <$> hidden singleQuotesOnlyStringTok+ typedLiteral =+ TypedLit <$> hidden (typeName' True) <*> singleQuotesOnlyStringTok+ keywordFunctionOrIden = do+ d <- askDialect id+ x <- hidden (keywordTok (diIdentifierKeywords d ++ diAppKeywords d))+ let i = T.toLower x `elem` diIdentifierKeywords d+ a = T.toLower x `elem` diAppKeywords d+ case () of+ _ | i && a -> pure [Name Nothing x] <**> (hidden app <|> pure Iden)+ | i -> pure (Iden [Name Nothing x])+ | a -> pure [Name Nothing x] <**> app+ | otherwise -> -- shouldn't get here+ fail $ "unexpected keyword: " <> T.unpack x++{-+=== 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 $ "unexpected " ++ 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 =+ hidden openParen *> choice+ [hidden duplicates+ <**> (commaSep1 scalarExprOrStar+ <**> ((hoption [] orderBy <* closeParen)+ <**> (hoptional afilter <**> pure (flip5 AggregateApp))))+ -- separate cases with no all or distinct which must have at+ -- least one scalar expr+ ,commaSep1 scalarExprOrStar+ <**> choice+ [closeParen *> hidden (choice+ [window+ ,withinGroup+ ,(Just <$> afilter) <**> pure (flip3 aggAppWithoutDupeOrd)+ ,pure (flip App)])+ ,hidden orderBy <* closeParen+ <**> (hoptional afilter <**> pure (flip4 aggAppWithoutDupe))]+ -- no scalarExprs: duplicates and order by not allowed+ ,([] <$ closeParen) <**> choice+ [window+ ,withinGroup+ ,pure $ flip App]+ ]+ 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) <**> pure (flip3 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) <**> pure (flip5 WindowApp)))+ where+ partitionBy =+ label "partition by" $+ keywords_ ["partition","by"] *> commaSep1 scalarExpr+ frameClause =+ label "frame clause" $+ frameRowsRange -- TODO: this 'and' could be an issue+ <**> choice [(keyword_ "between" *> frameLimit True)+ <**> ((keyword_ "and" *> frameLimit True)+ <**> pure (flip3 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 "collation name"+ 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 =+ braces (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 (hidden $ mkBinOp nm <$ symbol_ nm)+ binarySymR nm = E.InfixR (hidden $ mkBinOp nm <$ symbol_ nm)+ binarySymN nm = E.InfixN (hidden $ mkBinOp nm <$ symbol_ nm)+ binaryKeywordN nm = E.InfixN (hidden $ mkBinOp nm <$ keyword_ nm)+ binaryKeywordL nm = E.InfixL (hidden $ mkBinOp nm <$ keyword_ nm)+ mkBinOp nm a b = BinOp a (mkNm nm) b+ prefixSym nm = prefix (hidden $ PrefixOp (mkNm nm) <$ symbol_ nm)+ prefixKeyword nm = prefix (hidden $ PrefixOp (mkNm nm) <$ keyword_ nm)+ mkNm nm = [Name Nothing nm]+ binaryKeywordsN p =+ E.InfixN (hidden $ do+ o <- try p+ pure (\a b -> BinOp a [Name Nothing $ T.unwords o] b))+ multisetBinOp = E.InfixL (hidden $ do+ keyword_ "multiset"+ o <- choice [Union <$ keyword_ "union"+ ,Intersect <$ keyword_ "intersect"+ ,Except <$ keyword_ "except"]+ d <- hoption SQDefault duplicates+ pure (\a b -> MultisetBinOp a o d b))+ postfixKeywords p =+ postfix $ hidden $ do+ o <- try p+ pure $ PostfixOp [Name Nothing $ T.unwords o]+ -- parse repeated prefix or postfix operators+ postfix p = E.Postfix $ foldr1 (flip (.)) <$> some (hidden p)+ prefix p = E.Prefix $ foldr1 (.) <$> some (hidden 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 = expressionLabel $ E.makeExprParser term (opTable False)++-- used when parsing contexts where a * or x.* is allowed+-- currently at the top level of a select item or top level of+-- argument passed to an app-like. This list may need to be extended.++scalarExprOrStar :: Parser ScalarExpr+scalarExprOrStar = star <|> scalarExpr++-- use this to get a nice unexpected keyword error which doesn't also+-- mangle other errors+expressionLabel :: Parser a -> Parser a+expressionLabel p = label "expression" p <|> failOnKeyword++term :: Parser ScalarExpr+term = expressionLabel $+ choice+ [simpleLiteral+ ,parameter+ ,positionalArg+ ,parensExpr+ ,caseExpr+ ,cast+ ,convertSqlServer+ ,arrayCtor+ ,multisetCtor+ ,nextValueFor+ ,subquery+ ,intervalLit+ ,specialOpKs+ ,idenExpr+ ,odbcExpr]++-- expose the b expression for window frame clause range between++scalarExprB :: Parser ScalarExpr+scalarExprB = label "expression" $ 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 =+ label "select item" $ choice+ [(,Nothing) <$> star+ ,(,) <$> scalarExpr <*> optional als]+ where+ als = label "alias" $ optional (keyword_ "as") *> name "alias"++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 = label "from" (keyword_ "from" *> commaSep1 tref)+ where+ tref = nonJoinTref <**> (hidden (chainl tjoin) <|> pure id)+ nonJoinTref =+ label "table ref" $ choice+ [hidden $ parens $ choice+ -- will be tricky to figure out how to support mixes of nested+ -- query expr parens and table ref parens+ [TRQueryExpr <$> queryExprNoParens+ ,TRParens <$> tref]+ ,TRLateral <$> (hidden (keyword_ "lateral") *> nonJoinTref)+ ,do+ n <- names "table name"+ choice [TRFunction n <$> hidden (parens (commaSep scalarExpr))+ ,pure $ TRSimple n]+ -- todo: I think you can only have outer joins inside the oj,+ -- not sure.+ ,TROdbc <$> (hidden (braces (keyword_ "oj" *> tref)))+ ] <**> (talias <|> pure id)+ talias = fromAlias <**> pure (flip TRAlias)+ tjoin =+ (\jn jt tr1 jc tr0 -> TRJoin tr0 jn jt tr1 jc)+ <$> option False (True <$ keyword_ "natural")+ <*> joinType+ <*> nonJoinTref+ <*> hoptional joinCondition+ chainl p = foldr (.) id . reverse <$> some p+++{-+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 "column name"))]++fromAlias :: Parser Alias+fromAlias = Alias <$> tableAlias <*> columnAliases+ where+ tableAlias = hoptional (keyword_ "as") *> name "alias"+ columnAliases = hoptional $ parens $ commaSep1 (name "column name")++{-+== simple other parts++Parsers for where, group by, having, order by and limit, which are+pretty trivial.+-}++whereClause :: Parser ScalarExpr+whereClause = label "where" (keyword_ "where" *> scalarExpr)++groupByClause :: Parser [GroupingExpr]+groupByClause =+ label "group by" (keywords_ ["group","by"] *> commaSep1 groupingExpression)+ where+ groupingExpression =+ label "grouping expression" $+ 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 = label "having" (keyword_ "having" *> scalarExpr)++orderBy :: Parser [SortSpec]+orderBy = label "order by" (keywords_ ["order","by"] *> commaSep1 ob)+ where+ ob = SortSpec+ <$> scalarExpr+ <*> hoption DirDefault (choice [Asc <$ keyword_ "asc"+ ,Desc <$ keyword_ "desc"])+ <*> hoption 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 = label "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 <$> hoption False (True <$ keyword_ "recursive")+ <*> commaSep1 withQuery <*> queryExpr+ where+ withQuery = (,) <$> (withAlias <* keyword_ "as")+ <*> parens queryExpr+ withAlias = Alias <$> name "alias" <*> columnAliases+ columnAliases = hoptional $ parens $ commaSep1 (name "column alias")+++{-+== query expression++This parser parses any query expression variant: normal select, cte,+and union, etc..+-}++queryExpr :: Parser QueryExpr+queryExpr = queryExpr' True+queryExprNoParens :: Parser QueryExpr+queryExprNoParens = queryExpr' False++queryExpr' :: Bool -> Parser QueryExpr+queryExpr' allowParens = label "query expr" $ E.makeExprParser qeterm qeOpTable+ where+ qeterm+ | allowParens =+ label "query expr" (with <|> select <|> table <|> values <|> qeParens)+ | otherwise =+ label "query expr" (with <|> select <|> table <|> values)++ select = keyword_ "select" >>+ mkSelect+ <$> hoption SQDefault duplicates+ <*> selectList+ <*> optional tableExpression+ 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 "table name"+ qeParens = QueryExprParens <$> parens queryExpr++ 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 = hidden (cq+ <$> (ctor <$ keyword_ opName)+ <*> hoption SQDefault duplicates+ <*> corr)+ cq o d c q0 q1 = QueryExprSetOp q0 o d c q1+ corr = hoption 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 =+ label "from" $+ mkTe+ <$> from+ <*> optional whereClause+ <*> option [] groupByClause+ <*> optional having+ <*> option [] orderBy+ <*> (hidden 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 =+ label "statement" $ 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 <$ hidden semi++createSchema :: Parser Statement+createSchema = keyword_ "schema" >>+ CreateSchema <$> names "schema name"++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 (hidden separator)+ entries = ((:) <$> parseColumnDef <*> ((comma >> entries) <|> pure [])) <|> constraints+ withoutRowid = if diWithoutRowidTables d+ then fromMaybe False <$> optional (keywords_ ["without", "rowid"] >> pure True)+ else pure False++ keyword_ "table" >>+ CreateTable+ <$> names "table name"+ <*> parens entries+ <*> withoutRowid++createIndex :: Parser Statement+createIndex =+ CreateIndex+ <$> ((keyword_ "index" >> pure False) <|>+ (keywords_ ["unique", "index"] >> pure True))+ <*> names "index name"+ <*> (keyword_ "on" >> names "table name")+ <*> parens (commaSep1 (name "column name"))++columnDef :: Parser ColumnDef+columnDef = do+ optionalType <- askDialect diOptionalColumnTypes+ ColumnDef <$> name "column name"+ <*> (if optionalType then optional typeName else Just <$> typeName)+ <*> option [] (some colConstraintDef)++tableConstraintDef :: Parser (Maybe [Name], TableConstraint)+tableConstraintDef =+ label "table constraint" $+ (,)+ <$> optional (keyword_ "constraint" *> names "constraint name")+ <*> (unique <|> primaryKey <|> check <|> references)+ where+ unique = keyword_ "unique" >>+ TableUniqueConstraint <$> parens (commaSep1 $ name "column name")+ primaryKey = keywords_ ["primary", "key"] >>+ TablePrimaryKeyConstraint <$> parens (commaSep1 $ name "column 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 "column name")+ <*> (keyword_ "references" *> names "table name")+ <*> hoptional (parens $ commaSep1 $ name "column name")+ <*> refMatch+ <*> refActions++refMatch :: Parser ReferenceMatch+refMatch = hoption 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 "constraint name")+ <*> (nullable+ <|> notNull+ <|> unique+ <|> primaryKey+ <|> check+ <|> references+ <|> defaultClause+ )+ 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 "table name"+ <*> optional (parens $ name "column name")+ <*> refMatch+ <*> refActions+ defaultClause = label "column default clause" $+ ColDefaultClause <$> 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))+ ]++-- 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 "table name"+ <*> choice [addConstraint+ ,dropConstraint+ ,addColumnDef+ ,alterColumn+ ,dropColumn+ ]+ where+ addColumnDef = try (keyword_ "add"+ *> optional (keyword_ "column")) >>+ AddColumnDef <$> columnDef+ alterColumn = keyword_ "alter" >> optional (keyword_ "column") >>+ name "column name"+ <**> choice [setDefault+ ,dropDefault+ ,setNotNull+ ,dropNotNull+ ,setDataType]+ setDefault :: Parser (Name -> AlterTableAction)+ -- todo: left factor+ setDefault = try (keywords_ ["set","default"]) >>+ scalarExpr <**> pure (flip 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 <**> pure (flip AlterColumnSetDataType)+ dropColumn = try (keyword_ "drop" *> optional (keyword_ "column")) >>+ DropColumn <$> name "column name" <*> dropBehaviour+ -- todo: left factor, this try is especially bad+ addConstraint = try (keyword_ "add" >>+ uncurry AddTableConstraintDef <$> tableConstraintDef)+ dropConstraint = try (keywords_ ["drop","constraint"]) >>+ DropTableConstraintDef <$> names "constraint name" <*> dropBehaviour+++dropSchema :: Parser Statement+dropSchema = keyword_ "schema" >>+ DropSchema <$> names "schema name" <*> dropBehaviour++dropTable :: Parser Statement+dropTable = keyword_ "table" >>+ DropTable <$> names "table name" <*> dropBehaviour++createView :: Parser Statement+createView =+ CreateView+ <$> (hoption False (True <$ keyword_ "recursive") <* keyword_ "view")+ <*> names "view name"+ <*> optional (parens (commaSep1 $ name "column name"))+ <*> (keyword_ "as" *> queryExpr)+ <*> hoptional (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 "view name" <*> dropBehaviour++createDomain :: Parser Statement+createDomain = keyword_ "domain" >>+ CreateDomain+ <$> names "domain name"+ <*> ((optional (keyword_ "as") *> typeName) <?> "alias")+ <*> optional (keyword_ "default" *> scalarExpr)+ <*> many con+ where+ con = (,) <$> optional (keyword_ "constraint" *> names "constraint name")+ <*> (keyword_ "check" *> parens scalarExpr)++alterDomain :: Parser Statement+alterDomain = keyword_ "domain" >>+ AlterDomain+ <$> names "domain name"+ <*> (setDefault <|> constraint+ <|> (keyword_ "drop" *> (dropDefault <|> dropConstraint)))+ where+ setDefault = keywords_ ["set", "default"] >> ADSetDefault <$> scalarExpr+ constraint = keyword_ "add" >>+ ADAddConstraint+ <$> optional (keyword_ "constraint" *> names "constraint name")+ <*> (keyword_ "check" *> parens scalarExpr)+ dropDefault = ADDropDefault <$ keyword_ "default"+ dropConstraint = keyword_ "constraint" >> ADDropConstraint <$> names "constraint name"++dropDomain :: Parser Statement+dropDomain = keyword_ "domain" >>+ DropDomain <$> names "domain name" <*> dropBehaviour++createSequence :: Parser Statement+createSequence = keyword_ "sequence" >>+ CreateSequence+ <$> names "sequence name"+ <*> sequenceGeneratorOptions++alterSequence :: Parser Statement+alterSequence = keyword_ "sequence" >>+ AlterSequence+ <$> names "sequence name"+ <*> sequenceGeneratorOptions++dropSequence :: Parser Statement+dropSequence = keyword_ "sequence" >>+ DropSequence <$> names "sequence name" <*> dropBehaviour++createAssertion :: Parser Statement+createAssertion = keyword_ "assertion" >>+ CreateAssertion+ <$> names "assertion name"+ <*> (keyword_ "check" *> parens scalarExpr)+++dropAssertion :: Parser Statement+dropAssertion = keyword_ "assertion" >>+ DropAssertion <$> names "assertion name" <*> dropBehaviour++{-+-----------------++= dml+-}++delete :: Parser Statement+delete = keywords_ ["delete","from"] >>+ Delete+ <$> names "table name"+ <*> optional (hoptional (keyword_ "as") *> name "alias")+ <*> optional (keyword_ "where" *> scalarExpr)++truncateSt :: Parser Statement+truncateSt = keywords_ ["truncate", "table"] >>+ Truncate+ <$> names "table name"+ <*> hoption DefaultIdentityRestart+ (ContinueIdentity <$ keywords_ ["continue","identity"]+ <|> RestartIdentity <$ keywords_ ["restart","identity"])++insert :: Parser Statement+insert = keywords_ ["insert", "into"] >>+ Insert+ <$> names "table name"+ <*> (hoptional (parens $ commaSep1 $ name "column name"))+ <*>+ -- slight hack+ (DefaultInsertValues <$ label "values" (keywords_ ["default", "values"])+ <|> InsertQuery <$> queryExpr)++update :: Parser Statement+update = keywords_ ["update"] >>+ Update+ <$> names "table name"+ <*> label "alias" (optional (optional (keyword_ "as") *> name "alias"))+ <*> (keyword_ "set" *> commaSep1 setClause)+ <*> optional (keyword_ "where" *> scalarExpr)+ where+ setClause = label "set clause" (multipleSet <|> singleSet)+ multipleSet = SetMultiple+ <$> parens (commaSep1 $ names "column name")+ <*> (symbol "=" *> parens (commaSep1 scalarExpr))+ singleSet = Set+ <$> names "column name"+ <*> (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 "savepoint name"++releaseSavepoint :: Parser Statement+releaseSavepoint = keywords_ ["release","savepoint"] >>+ ReleaseSavepoint <$> name "savepoint name"++commit :: Parser Statement+commit = Commit <$ keyword_ "commit" <* hoptional (keyword_ "work")++rollback :: Parser Statement+rollback = keyword_ "rollback" >> hoptional (keyword_ "work") >>+ Rollback <$> optional (keywords_ ["to", "savepoint"] *> name "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 "role name"))+ <*> option WithoutGrantOption+ (WithGrantOption <$ keywords_ ["with","grant","option"])+ role = GrantRole+ <$> commaSep (name "role name")+ <*> (keyword_ "to" *> commaSep (name "role name"))+ <*> option WithoutAdminOption+ (WithAdminOption <$ keywords_ ["with","admin","option"])++createRole :: Parser Statement+createRole = keyword_ "role" >>+ CreateRole <$> name "role name"++dropRole :: Parser Statement+dropRole = keyword_ "role" >>+ DropRole <$> name "role 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 "role name"))+ <*> dropBehaviour+ role = RevokeRole+ <$> option NoAdminOptionFor+ (AdminOptionFor <$ keywords_ ["admin","option", "for"])+ <*> commaSep (name "role name")+ <*> (keyword_ "from" *> commaSep (name "role name"))+ <*> dropBehaviour++privilegeAction :: Parser PrivilegeAction+privilegeAction = choice+ [PrivAll <$ keywords_ ["all","privileges"]+ ,keyword_ "select" >>+ PrivSelect <$> option [] (parens $ commaSep $ name "column name")+ ,PrivDelete <$ keyword_ "delete"+ ,PrivUsage <$ keyword_ "usage"+ ,PrivTrigger <$ keyword_ "trigger"+ ,PrivExecute <$ keyword_ "execute"+ ,keyword_ "insert" >>+ PrivInsert <$> option [] (parens $ commaSep $ name "column name")+ ,keyword_ "update" >>+ PrivUpdate <$> option [] (parens $ commaSep $ name "column name")+ ,keyword_ "references" >>+ PrivReferences <$> option [] (parens $ commaSep $ name "column name")+ ]++privilegeObject :: Parser PrivilegeObject+privilegeObject = choice+ [keyword_ "domain" >> PrivDomain <$> names "domain name"+ ,keyword_ "type" >> PrivType <$> names "type name"+ ,keyword_ "sequence" >> PrivSequence <$> names "sequence name"+ ,keywords_ ["specific","function"] >> PrivFunction <$> names "function name"+ ,optional (keyword_ "table") >> PrivTable <$> names "table name"+ ]+++{-+----------------------------++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 =+ label (T.intercalate ", " 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++{-+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++TODO: this name is not so good because it's similar to <?> which does+something completely different+-}++(<??>) :: Parser a -> Parser (a -> a) -> Parser a+p <??> q = p <**> hoption id q++-- 0 to many repeated applications of suffix parser++chainrSuffix :: Parser a -> Parser (a -> a) -> Parser a+chainrSuffix p q = foldr ($) <$> p <*> (reverse <$> many (hidden 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) <?> s++singleCharSymbol :: Char -> Parser Char+singleCharSymbol c = c <$ symbol (T.singleton c)++questionMark :: Parser Char+questionMark = singleCharSymbol '?' <?> "question mark"++openParen :: Parser ()+openParen = void $ singleCharSymbol '('++closeParen :: Parser ()+closeParen = void $ singleCharSymbol ')'++comma :: Parser Char+comma = singleCharSymbol ','++semi :: Parser Char+semi = singleCharSymbol ';'++-- = helper functions++keyword :: Text -> Parser Text+keyword k = keywordTok [k] <?> k++-- helper function to improve error messages++keywords_ :: [Text] -> Parser ()+keywords_ ks = label (T.unwords ks) $ mapM_ keyword_ ks++parens :: Parser a -> Parser a+parens = between openParen closeParen++brackets :: Parser a -> Parser a+brackets = between (singleCharSymbol '[') (singleCharSymbol ']')++braces :: Parser a -> Parser a+braces = between (singleCharSymbol '{') (singleCharSymbol '}')++commaSep :: Parser a -> Parser [a]+commaSep = (`sepBy` hidden comma)++keyword_ :: Text -> Parser ()+keyword_ = void . keyword++symbol_ :: Text -> Parser ()+symbol_ = void . symbol++commaSep1 :: Parser a -> Parser [a]+commaSep1 = (`sepBy1` hidden comma)++hoptional :: Parser a -> Parser (Maybe a)+hoptional = hidden . optional++hoption :: a -> Parser a -> Parser a+hoption a p = hidden $ option a p++label :: Text -> Parser a -> Parser a+label x = M.label (T.unpack x)++(<?>) :: Parser a -> Text -> Parser a+(<?>) p a = (M.<?>) p (T.unpack a)++------------------------------------------------------------------------------++-- 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.++TODO: move this to the lexer?+-}++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 <?> "host param"+ where+ test (L.WithPos _ _ _ (L.PrefixedVariable c p)) = Just $ T.cons c p+ test _ = Nothing++positionalArgTok :: Parser Int+positionalArgTok = token test Set.empty <?> "positional arg"+ where+ test (L.WithPos _ _ _ (L.PositionalArg p)) = Just p+ test _ = Nothing++sqlNumberTok :: Bool -> Parser Text+sqlNumberTok intOnly = token test Set.empty <?> "number"+ 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 <?> lbl+ where+ test (L.WithPos _ _ _ (L.Symbol p)) =+ case sym of+ Nothing -> Just p+ Just sym' | sym' == p -> Just p+ _ -> Nothing+ test _ = Nothing+ lbl = case sym of+ Nothing -> "symbol"+ Just p -> p++{-+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 = do+ token test Set.empty <?> "identifier"+ where+ test (L.WithPos _ _ _ (L.Identifier q@(Just {}) p)) = Just (q,p)+ test (L.WithPos _ _ _ (L.Identifier q@Nothing p))+ | T.toLower p `notElem` blackList = Just (q,p)+ test _ = Nothing++keywordTok :: [Text] -> Parser Text+keywordTok allowed = do+ token test Set.empty where+ test (L.WithPos _ _ _ (L.Identifier Nothing p))+ | T.toLower p `elem` allowed = Just p+ test _ = Nothing+++unexpectedKeywordError :: Text -> Parser a+unexpectedKeywordError kw =+ failure (Just $ Label (NE.fromList $ T.unpack $ "keyword " <> kw)) Set.empty++failOnKeyword :: Parser a+failOnKeyword = do+ kws <- asks diKeywords+ i <- lookAhead $ keywordTok kws+ unexpectedKeywordError i++------------------------------------------------------------------------------++-- dialect++guardDialect :: (Dialect -> Bool) -> Parser ()+guardDialect p = guard . p =<< ask++askDialect :: (Dialect -> a) -> Parser a+askDialect = asks+
− Language/SQL/SimpleSQL/Parser.lhs
@@ -1,2018 +0,0 @@--= TOC:--notes-Public api-Names - parsing identifiers-Typenames-Value 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- value 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 rrror 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- * value 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 value expressions--There are a lot of value 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 value 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.--value expressions: every variation on value 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 value 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.Parser-> (parseQueryExpr-> ,parseValueExpr-> ,parseQueryExprs-> ,ParseError(..)) where--> import Control.Monad.Identity (Identity)-> import Control.Monad (guard, void, when)-> import Control.Applicative ((<$), (<$>), (<*>) ,(<*), (*>), (<**>), pure)-> import Data.Maybe (catMaybes)-> import Data.Char (toLower)-> import Text.Parsec (setPosition,setSourceColumn,setSourceLine,getPosition-> ,option,between,sepBy,sepBy1,string,manyTill,anyChar-> ,try,string,many1,oneOf,digit,(<|>),choice,char,eof-> ,optionMaybe,optional,many,letter,runParser-> ,chainl1, chainr1,(<?>) {-,notFollowedBy,alphaNum-}, lookAhead)-> -- import Text.Parsec.String (Parser)-> import Text.Parsec.Perm (permute,(<$?>), (<|?>))-> import Text.Parsec.Prim (Parsec, getState)-> import qualified Text.Parsec.Expr as E-> import Data.List (intercalate,sort,groupBy)-> import Data.Function (on)-> import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Combinators-> import Language.SQL.SimpleSQL.Errors--= 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 list of query expressions, with semi colons between-> -- them. The final semicolon is optional.-> parseQueryExprs :: 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]-> parseQueryExprs = wrapParse queryExprs--> -- | Parses a value expression.-> parseValueExpr :: 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 ValueExpr-> parseValueExpr = wrapParse valueExpr--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 =-> either (Left . convParseError src) Right-> $ runParser (setPos p *> whitespace *> parser <* eof)-> d f src-> where-> setPos Nothing = pure ()-> setPos (Just (l,c)) = fmap up getPosition >>= setPosition-> where up = flip setSourceColumn c . flip setSourceLine l----------------------------------------------------= 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-value 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-> choice [QName <$> quotedIdentifier-> ,UQName <$> uquotedIdentifier-> ,Name <$> identifierBlacklist (blacklist d)-> ,dqName]-> where-> dqName = guardDialect [MySQL] *>-> lexeme (DQName "`" "`"-> <$> (char '`'-> *> manyTill anyChar (char '`')))--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 = lexeme $-> (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"-> <|> PrecOctets <$ keyword_ "octets"-> 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 = (:[]) . Name . unwords <$> makeKeywordTree-> ["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"-> ]--= Value expressions--== simple literals--See the stringToken lexer below for notes on string literal syntax.--> stringLit :: Parser ValueExpr-> stringLit = StringLit <$> stringToken--> numberLit :: Parser ValueExpr-> numberLit = NumLit <$> numberLiteral--> characterSetLit :: Parser ValueExpr-> characterSetLit =-> CSStringLit <$> shortCSPrefix <*> stringToken-> where-> shortCSPrefix = try $ choice-> [(:[]) <$> oneOf "nNbBxX"-> ,string "u&"-> ,string "U&"-> ] <* lookAhead quote--> simpleLiteral :: Parser ValueExpr-> simpleLiteral = numberLit <|> stringLit <|> characterSetLit--== 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 value expression context.--> star :: Parser ValueExpr-> 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 ValueExpr-> parameter = choice-> [Parameter <$ questionMark-> ,HostParameter-> <$> hostParameterToken-> <*> optionMaybe (keyword "indicator" *> hostParameterToken)]--== parens--value expression parens, row ctor and scalar subquery--> parensExpr :: Parser ValueExpr-> parensExpr = parens $ choice-> [SubQueryExpr SqSq <$> queryExpr-> ,ctor <$> commaSep1 valueExpr]-> where-> ctor [a] = Parens a-> ctor as = SpecialOp [Name "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 ValueExpr-> caseExpr =-> Case <$> (keyword_ "case" *> optionMaybe valueExpr)-> <*> many1 whenClause-> <*> optionMaybe elseClause-> <* keyword_ "end"-> where-> whenClause = (,) <$> (keyword_ "when" *> commaSep1 valueExpr)-> <*> (keyword_ "then" *> valueExpr)-> elseClause = keyword_ "else" *> valueExpr--=== cast--cast: cast(expr as type)--> cast :: Parser ValueExpr-> cast = keyword_ "cast" *>-> parens (Cast <$> valueExpr-> <*> (keyword_ "as" *> typeName))--=== exists, unique--subquery expression:-[exists|unique] (queryexpr)--> subquery :: Parser ValueExpr-> subquery = SubQueryExpr <$> sqkw <*> parens queryExpr-> where-> sqkw = SqExists <$ keyword_ "exists" <|> SqUnique <$ keyword_ "unique"--=== array/multiset constructor--> arrayCtor :: Parser ValueExpr-> arrayCtor = keyword_ "array" >>-> choice-> [ArrayCtor <$> parens queryExpr-> ,Array (Iden [Name "array"]) <$> brackets (commaSep valueExpr)]--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 ValueExpr-> multisetCtor =-> choice-> [keyword_ "multiset" >>-> choice-> [MultisetQueryCtor <$> parens queryExpr-> ,MultisetCtor <$> brackets (commaSep valueExpr)]-> ,keyword_ "table" >>-> MultisetQueryCtor <$> parens queryExpr]--> nextValueFor :: Parser ValueExpr-> 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 ValueExpr-> intervalLit = try (keyword_ "interval" >> do-> s <- optionMaybe $ choice [True <$ symbol_ "+"-> ,False <$ symbol_ "-"]-> lit <- stringToken-> q <- optionMaybe intervalQualifier-> mkIt s lit q)-> where-> mkIt Nothing val Nothing = pure $ TypedLit (TypeName [Name "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 value expressions which start with an identifier--(todo: really put all of them here instead of just some of them)--> idenExpr :: Parser ValueExpr-> idenExpr =-> -- todo: work out how to left factor this-> try (TypedLit <$> typeName <*> stringToken)-> <|> (names <**> option Iden app)--=== 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 ValueExpr-> specialOpK opName firstArg kws =-> keyword_ opName >> do-> void openParen-> let pfa = do-> e <- valueExpr-> -- check we haven't parsed the first-> -- keyword as an identifier-> guard (case (e,kws) of-> (Iden [Name i], (k,_):_) | map toLower i == k -> False-> _ -> True)-> 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 opName] fa $ catMaybes as-> where-> parseArg (nm,mand) =-> let p = keyword_ nm >> valueExpr-> 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 ValueExpr-> specialOpKs = choice $ map try-> [extract, position, substring, convert, translate, overlay, trim]--> extract :: Parser ValueExpr-> extract = specialOpK "extract" SOKMandatory [("from", True)]--> position :: Parser ValueExpr-> 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 ValueExpr-> substring = specialOpK "substring" SOKMandatory-> [("from", False),("for", False)]--> convert :: Parser ValueExpr-> convert = specialOpK "convert" SOKMandatory [("using", True)]---> translate :: Parser ValueExpr-> translate = specialOpK "translate" SOKMandatory [("using", True)]--> overlay :: Parser ValueExpr-> 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 ValueExpr-> trim =-> keyword "trim" >>-> parens (mkTrim-> <$> option "both" sides-> <*> option " " stringToken-> <*> (keyword_ "from" *> valueExpr))-> where-> sides = choice ["leading" <$ keyword_ "leading"-> ,"trailing" <$ keyword_ "trailing"-> ,"both" <$ keyword_ "both"]-> mkTrim fa ch fr =-> SpecialOpK [Name "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 value 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] -> ValueExpr)-> app =-> openParen *> choice-> [duplicates-> <**> (commaSep1 valueExpr-> <**> (((option [] orderBy) <* closeParen)-> <**> (optionMaybe afilter <$$$$$> AggregateApp)))-> -- separate cases with no all or distinct which must have at-> -- least one value expr-> ,commaSep1 valueExpr-> <**> choice-> [closeParen *> choice-> [window-> ,withinGroup-> ,(Just <$> afilter) <$$$> aggAppWithoutDupeOrd-> ,pure (flip App)]-> ,orderBy <* closeParen-> <**> (optionMaybe afilter <$$$$> aggAppWithoutDupe)]-> -- no valueExprs: 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 ValueExpr-> afilter = keyword_ "filter" *> parens (keyword_ "where" *> valueExpr)--> withinGroup :: Parser ([ValueExpr] -> [Name] -> ValueExpr)-> 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 ([ValueExpr] -> [Name] -> ValueExpr)-> window =-> keyword_ "over" *> openParen *> option [] partitionBy-> <**> (option [] orderBy-> <**> (((optionMaybe frameClause) <* closeParen) <$$$$$> WindowApp))-> where-> partitionBy = keywords_ ["partition","by"] *> commaSep1 valueExpr-> 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 valueExprB else valueExpr)-> <**> (Preceding <$ keyword_ "preceding"-> <|> Following <$ keyword_ "following")-> ]--== suffixes--These are all generic suffixes on any value expr--=== in--in: two variations:-a in (expr0, expr1, ...)-a in (queryexpr)--> inSuffix :: Parser (ValueExpr -> ValueExpr)-> inSuffix =-> mkIn <$> inty-> <*> parens (choice-> [InQueryExpr <$> queryExpr-> ,InList <$> commaSep1 valueExpr])-> 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 value expression parser which-is identical to the normal one expect it doesn't recognise the binary-and operator. This is the call to valueExprB.--> betweenSuffix :: Parser (ValueExpr -> ValueExpr)-> betweenSuffix =-> makeOp <$> Name <$> opName-> <*> valueExprB-> <*> (keyword_ "and" *> valueExprB)-> 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 (ValueExpr -> ValueExpr)-> quantifiedComparisonSuffix = do-> c <- comp-> cq <- compQuan-> q <- parens queryExpr-> pure $ \v -> QuantifiedComparison v [c] cq q-> where-> comp = Name <$> choice (map symbol-> ["=", "<>", "<=", "<", ">", ">="])-> compQuan = choice-> [CPAny <$ keyword_ "any"-> ,CPSome <$ keyword_ "some"-> ,CPAll <$ keyword_ "all"]--=== match--a match (select a from t)--> matchPredicateSuffix :: Parser (ValueExpr -> ValueExpr)-> matchPredicateSuffix = do-> keyword_ "match"-> u <- option False (True <$ keyword_ "unique")-> q <- parens queryExpr-> pure $ \v -> Match v u q--=== array subscript--> arraySuffix :: Parser (ValueExpr -> ValueExpr)-> arraySuffix = do-> es <- brackets (commaSep valueExpr)-> pure $ \v -> Array v es--=== escape--> escapeSuffix :: Parser (ValueExpr -> ValueExpr)-> escapeSuffix = do-> ctor <- choice-> [Escape <$ keyword_ "escape"-> ,UEscape <$ keyword_ "uescape"]-> c <- anyChar-> pure $ \v -> ctor v c--=== collate--> collateSuffix:: Parser (ValueExpr -> ValueExpr)-> collateSuffix = do-> keyword_ "collate"-> i <- names-> pure $ \v -> Collate v i---== 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 String ParseState Identity ValueExpr]]-> 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' escapeSuffix-> ,postfix' collateSuffix]-> ,[prefixSym "+", prefixSym "-"]-> ,[binarySym "^" E.AssocLeft]-> ,[binarySym "*" E.AssocLeft-> ,binarySym "/" E.AssocLeft-> ,binarySym "%" E.AssocLeft]-> ,[binarySym "+" E.AssocLeft-> ,binarySym "-" E.AssocLeft]-> ,[binarySym ">=" E.AssocNone-> ,binarySym "<=" E.AssocNone-> ,binarySym "!=" E.AssocRight-> ,binarySym "<>" E.AssocRight-> ,binarySym "||" E.AssocRight-> ,prefixSym "~"-> ,binarySym "&" E.AssocRight-> ,binarySym "|" E.AssocRight-> ,binaryKeyword "like" E.AssocNone-> ,binaryKeyword "overlaps" E.AssocNone]-> ++ [binaryKeywords $ makeKeywordTree-> ["not like"-> ,"is similar to"-> ,"is not similar to"-> ,"is distinct from"-> ,"is not distinct from"]-> ,postfixKeywords $ makeKeywordTree-> ["is null"-> ,"is not null"-> ,"is true"-> ,"is not true"-> ,"is false"-> ,"is not false"-> ,"is unknown"-> ,"is not unknown"]-> ]-> ++ [multisetBinOp]-> -- 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]-> ]-> ++-> [[binarySym "<" E.AssocNone-> ,binarySym ">" E.AssocNone]-> ,[binarySym "=" E.AssocRight]-> ,[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 $ unwords o] b))-> E.AssocNone-> postfixKeywords p =-> postfix' $ do-> o <- try p-> pure $ PostfixOp [Name $ unwords o]-> binary p nm assoc =-> E.Infix (p >> pure (\a b -> BinOp a [Name 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 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 (.))--== value expression top level--This parses most of the value 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.--> valueExpr :: Parser ValueExpr-> valueExpr = E.buildExpressionParser (opTable False) term--> term :: Parser ValueExpr-> term = choice [simpleLiteral-> ,parameter-> ,star-> ,parensExpr-> ,caseExpr-> ,cast-> ,arrayCtor-> ,multisetCtor-> ,nextValueFor-> ,subquery-> ,intervalLit-> ,specialOpKs-> ,idenExpr]-> <?> "value expression"--expose the b expression for window frame clause range between--> valueExprB :: Parser ValueExpr-> valueExprB = 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 (value 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 (ValueExpr,Maybe Name)-> selectItem = (,) <$> valueExpr <*> optionMaybe als-> where als = optional (keyword_ "as") *> name--> selectList :: Parser [(ValueExpr,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 valueExpr)-> ,pure $ TRSimple n]] <??> 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 <$> valueExpr-> ,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 ValueExpr-> whereClause = keyword_ "where" *> valueExpr--> 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 <$> valueExpr-> ]--> having :: Parser ValueExpr-> having = keyword_ "having" *> valueExpr--> orderBy :: Parser [SortSpec]-> orderBy = keywords_ ["order","by"] *> commaSep1 ob-> where-> ob = SortSpec-> <$> valueExpr-> <*> 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 ValueExpr, Maybe ValueExpr)-> offsetFetch = permute ((,) <$?> (Nothing, Just <$> offset)-> <|?> (Nothing, Just <$> fetch))--> offset :: Parser ValueExpr-> offset = keyword_ "offset" *> valueExpr-> <* option () (choice [keyword_ "rows"-> ,keyword_ "row"])--> fetch :: Parser ValueExpr-> fetch = fetchFirst <|> limit-> where-> fetchFirst = guardDialect [SQL2011]-> *> fs *> valueExpr <* ro-> fs = makeKeywordTree ["fetch first", "fetch next"]-> ro = makeKeywordTree ["rows only", "row only"]-> -- todo: not in ansi sql dialect-> limit = guardDialect [MySQL] *>-> keyword_ "limit" *> valueExpr--== common table expressions--> with :: Parser QueryExpr-> with = keyword_ "with" >>-> With <$> option False (True <$ keyword_ "recursive")-> <*> commaSep1 withQuery <*> queryExpr-> where-> withQuery = (,) <$> (fromAlias <* keyword_ "as")-> <*> parens queryExpr--== 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 valueExpr))-> 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 ValueExpr-> ,_teGroupBy :: [GroupingExpr]-> ,_teHaving :: Maybe ValueExpr-> ,_teOrderBy :: [SortSpec]-> ,_teOffset :: Maybe ValueExpr-> ,_teFetchFirst :: Maybe ValueExpr}--> 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 = CombineQueryExpr 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)--wrapper to parse a series of query exprs from a single source. They-must be separated by semicolon, but for the last expression, the-trailing semicolon is optional.--TODO: change style--> queryExprs :: Parser [QueryExpr]-> queryExprs = (:[]) <$> queryExpr-> >>= optionSuffix ((semi *>) . pure)-> >>= optionSuffix (\p -> (p++) <$> queryExprs)--------------------------------------------------= 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 parsers--whitespace parser which skips comments also--> whitespace :: Parser ()-> whitespace =-> choice [simpleWhitespace *> whitespace-> ,lineComment *> whitespace-> ,blockComment *> whitespace-> ,pure ()] <?> "whitespace"-> where-> lineComment = try (string "--")-> *> manyTill anyChar (void (char '\n') <|> eof)-> blockComment = -- no nesting of block comments in SQL-> try (string "/*")-> -- try used here so it doesn't fail when we see a-> -- '*' which isn't followed by a '/'-> *> manyTill anyChar (try $ string "*/")-> -- use many1 so we can more easily avoid non terminating loops-> simpleWhitespace = void $ many1 (oneOf " \t\n")--> lexeme :: Parser a -> Parser a-> lexeme p = p <* whitespace--> unsignedInteger :: Parser Integer-> unsignedInteger = read <$> lexeme (many1 digit) <?> "integer"---number literals--here is the rough grammar target:--digits-digits.[digits][e[+-]digits]-[digits].digits[e[+-]digits]-digitse[+-]digits--numbers are parsed to strings, not to a numeric type. This is to avoid-making a decision on how to represent numbers, the client code can-make this choice.--> numberLiteral :: Parser String-> numberLiteral = lexeme (-> (int <??> (pp dot <??.> pp int)-> <|> (++) <$> dot <*> int)-> <??> pp expon)-> where-> int = many1 digit-> dot = string "."-> expon = (:) <$> oneOf "eE" <*> sInt-> sInt = (++) <$> option "" (string "+" <|> string "-") <*> int-> pp = (<$$> (++))---> identifier :: Parser String-> identifier = lexeme ((:) <$> firstChar <*> many nonFirstChar)-> <?> "identifier"-> where-> firstChar = letter <|> char '_' <?> "identifier"-> nonFirstChar = digit <|> firstChar <?> ""--> quotedIdentifier :: Parser String-> quotedIdentifier = quotedIdenHelper--> quotedIdenHelper :: Parser String-> quotedIdenHelper =-> lexeme (dq *> manyTill anyChar dq >>= optionSuffix moreIden)-> <?> "identifier"-> where-> moreIden s0 = do-> void dq-> s <- manyTill anyChar dq-> optionSuffix moreIden (s0 ++ "\"" ++ s)-> dq = char '"' <?> "double quote"--> uquotedIdentifier :: Parser String-> uquotedIdentifier =-> try (string "u&" <|> string "U&") *> quotedIdenHelper-> <?> "identifier"--parses an identifier with a : prefix. The : isn't included in the-return value--> hostParameterToken :: Parser String-> hostParameterToken = lexeme $ char ':' *> identifier--todo: work out the symbol parsing better--> symbol :: String -> Parser String-> symbol s = try (lexeme $ do-> u <- choice (many1 (char '.') :-> map (try . string) [">=","<=","!=","<>","||"]-> ++ map (string . (:[])) "+-^*/%~&|<>=")-> guard (s == u)-> pure s)-> <?> s--> questionMark :: Parser Char-> questionMark = lexeme (char '?') <?> "question mark"--> openParen :: Parser Char-> openParen = lexeme $ char '('--> closeParen :: Parser Char-> closeParen = lexeme $ char ')'--> openBracket :: Parser Char-> openBracket = lexeme $ char '['--> closeBracket :: Parser Char-> closeBracket = lexeme $ char ']'---> comma :: Parser Char-> comma = lexeme (char ',') <?> "comma"--> semi :: Parser Char-> semi = lexeme (char ';') <?> "semicolon"--> quote :: Parser Char-> quote = lexeme (char '\'') <?> "single quote"--> --stringToken :: Parser String-> --stringToken = lexeme (char '\'' *> manyTill anyChar (char '\''))-> -- todo: tidy this up, add the prefixes stuff, and add the multiple-> -- string stuff-> stringToken :: Parser String-> stringToken =-> lexeme (nlquote *> manyTill anyChar nlquote-> >>= optionSuffix moreString)-> <?> "string"-> where-> moreString s0 = choice-> [-- handle two adjacent quotes-> do-> void nlquote-> s <- manyTill anyChar nlquote-> optionSuffix moreString (s0 ++ "'" ++ s)-> ,-- handle string in separate parts-> -- e.g. 'part 1' 'part 2'-> do --can this whitespace be factored out?-> -- since it will be parsed twice when there is no more literal-> -- yes: split the adjacent quote and multiline literal-> -- into two different suffixes-> -- won't need to call lexeme at the top level anymore after this-> try (whitespace <* nlquote)-> s <- manyTill anyChar nlquote-> optionSuffix moreString (s0 ++ s)-> ]-> -- non lexeme quote-> nlquote = char '\'' <?> "single quote"--= helper functions--> keyword :: String -> Parser String-> keyword k = try (do-> i <- identifier-> guard (map toLower i == k)-> pure 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)--> identifierBlacklist :: [String] -> Parser String-> identifierBlacklist bl = try (do-> i <- identifier-> when (map toLower i `elem` bl) $-> fail $ "keyword not allowed here: " ++ i-> pure i)-> <?> "identifier"--> blacklist :: Dialect -> [String]-> blacklist = reservedWord--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 effing 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).--> reservedWord :: Dialect -> [String]-> reservedWord SQL2011 =-> ["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"-> ]--TODO: create this list properly--> reservedWord MySQL = reservedWord SQL2011 ++ ["limit"]----------------bit hacky, used to make the dialect available during parsing so-different parsers can be used for different dialects--> type ParseState = Dialect--> type Parser = Parsec String ParseState--> guardDialect :: [Dialect] -> Parser ()-> guardDialect ds = do-> d <- getState-> guard (d `elem` ds)--TODO: the ParseState and the Dialect argument should be turned into a-flags struct. Part (or all?) of this struct is the dialect-information, but each dialect has different versions + a big set of-flags to control syntax variations within a version of a product-dialect (for instance, string and identifier parsing rules vary from-dialect to dialect and version to version, and most or all SQL DBMSs-appear to have a set of flags to further enable or disable variations-for quoting and escaping strings and identifiers).
+ Language/SQL/SimpleSQL/Pretty.hs view
@@ -0,0 +1,895 @@++-- | 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 _ (QStar nms) = names nms <> 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 (QueryExprParens qe) = parens (queryExpr d qe)+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 withoutRowid) =+ pretty "create" <+> pretty "table" <+> names nm+ <+> parens (commaSep $ map cd cds)+ <+> (if withoutRowid then texts [ "without", "rowid" ] else mempty)+ 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 cons) =+ name n <+> maybe mempty typeName t+ <+> 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+ pcon (ColDefaultClause clause) = case clause of+ DefaultClause def ->+ pretty "default" <+> scalarExpr d def+ GenerationClause e ->+ texts ["generated","always","as"] <+> parens (scalarExpr d e)+ 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))++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,456 +0,0 @@--> {-# LANGUAGE CPP #-}-> -> -- | 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-> ,prettyValueExpr-> ,prettyQueryExprs-> ) 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 Language.SQL.SimpleSQL.Syntax-> import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens,-> nest, Doc, punctuate, comma, sep, quotes,-> doubleQuotes, brackets,hcat)-> import Data.Maybe (maybeToList, catMaybes)-> import Data.List (intercalate)--#if MIN_VERSION_base(4,11,0)-> import Prelude hiding ((<>))-#endif--> -- | 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.-> prettyValueExpr :: Dialect -> ValueExpr -> String-> prettyValueExpr d = render . valueExpr d--> -- | Convert a list of query exprs to concrete syntax. A semi colon-> -- is inserted after each query expr.-> prettyQueryExprs :: Dialect -> [QueryExpr] -> String-> prettyQueryExprs d = render . vcat . map ((<> text ";\n") . queryExpr d)--= value expressions--> valueExpr :: Dialect -> ValueExpr -> Doc-> valueExpr _ (StringLit s) = quotes $ text $ doubleUpQuotes s--> valueExpr _ (NumLit s) = text s-> valueExpr _ (IntervalLit s v f t) =-> text "interval"-> <+> me (\x -> if x then text "+" else text "-") s-> <+> quotes (text v)-> <+> intervalTypeField f-> <+> me (\x -> text "to" <+> intervalTypeField x) t-> valueExpr _ (Iden i) = names i-> valueExpr _ Star = text "*"-> valueExpr _ Parameter = text "?"-> valueExpr _ (HostParameter p i) =-> text (':':p)-> <+> me (\i' -> text "indicator" <+> text (':':i')) i--> valueExpr d (App f es) = names f <> parens (commaSep (map (valueExpr d) es))--> valueExpr dia (AggregateApp f d es od fil) =-> names f-> <> parens ((case d of-> Distinct -> text "distinct"-> All -> text "all"-> SQDefault -> empty)-> <+> commaSep (map (valueExpr dia) es)-> <+> orderBy dia od)-> <+> me (\x -> text "filter"-> <+> parens (text "where" <+> valueExpr dia x)) fil--> valueExpr d (AggregateAppGroup f es od) =-> names f-> <> parens (commaSep (map (valueExpr d) es))-> <+> if null od-> then empty-> else text "within group" <+> parens (orderBy d od)--> valueExpr d (WindowApp f es pb od fr) =-> names f <> parens (commaSep $ map (valueExpr d) es)-> <+> text "over"-> <+> parens ((case pb of-> [] -> empty-> _ -> text "partition by"-> <+> nest 13 (commaSep $ map (valueExpr 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) = valueExpr d e <+> text "preceding"-> fpd (Following e) = valueExpr d e <+> text "following"--> valueExpr dia (SpecialOp nm [a,b,c]) | nm `elem` [[Name "between"]-> ,[Name "not between"]] =-> sep [valueExpr dia a-> ,names nm <+> valueExpr dia b-> ,nest (length (unnames nm) + 1) $ text "and" <+> valueExpr dia c]--> valueExpr d (SpecialOp [Name "rowctor"] as) =-> parens $ commaSep $ map (valueExpr d) as--> valueExpr d (SpecialOp nm es) =-> names nm <+> parens (commaSep $ map (valueExpr d) es)--> valueExpr d (SpecialOpK nm fs as) =-> names nm <> parens (sep $ catMaybes-> (fmap (valueExpr d) fs-> : map (\(n,e) -> Just (text n <+> valueExpr d e)) as))--> valueExpr d (PrefixOp f e) = names f <+> valueExpr d e-> valueExpr d (PostfixOp f e) = valueExpr d e <+> names f-> valueExpr d e@(BinOp _ op _) | op `elem` [[Name "and"], [Name "or"]] =-> -- special case for and, or, get all the ands so we can vcat them-> -- nicely-> case ands e of-> (e':es) -> vcat (valueExpr d e'-> : map ((names op <+>) . valueExpr 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-> valueExpr d (BinOp e0 [Name "."] e1) =-> valueExpr d e0 <> text "." <> valueExpr d e1-> valueExpr d (BinOp e0 f e1) =-> valueExpr d e0 <+> names f <+> valueExpr d e1--> valueExpr dia (Case t ws els) =-> sep $ [text "case" <+> me (valueExpr dia) t]-> ++ map w ws-> ++ maybeToList (fmap e els)-> ++ [text "end"]-> where-> w (t0,t1) =-> text "when" <+> nest 5 (commaSep $ map (valueExpr dia) t0)-> <+> text "then" <+> nest 5 (valueExpr dia t1)-> e el = text "else" <+> nest 5 (valueExpr dia el)-> valueExpr d (Parens e) = parens $ valueExpr d e-> valueExpr d (Cast e tn) =-> text "cast" <> parens (sep [valueExpr d e-> ,text "as"-> ,typeName tn])--> valueExpr _ (TypedLit tn s) =-> typeName tn <+> quotes (text s)--> valueExpr d (SubQueryExpr ty qe) =-> (case ty of-> SqSq -> empty-> SqExists -> text "exists"-> SqUnique -> text "unique"-> ) <+> parens (queryExpr d qe)--> valueExpr d (QuantifiedComparison v c cp sq) =-> valueExpr d v-> <+> names c-> <+> (text $ case cp of-> CPAny -> "any"-> CPSome -> "some"-> CPAll -> "all")-> <+> parens (queryExpr d sq)--> valueExpr d (Match v u sq) =-> valueExpr d v-> <+> text "match"-> <+> (if u then text "unique" else empty)-> <+> parens (queryExpr d sq)--> valueExpr d (In b se x) =-> valueExpr 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 (valueExpr d) es-> InQueryExpr qe -> queryExpr d qe)--> valueExpr d (Array v es) =-> valueExpr d v <> brackets (commaSep $ map (valueExpr d) es)--> valueExpr d (ArrayCtor q) =-> text "array" <> parens (queryExpr d q)--> valueExpr d (MultisetCtor es) =-> text "multiset" <> brackets (commaSep $ map (valueExpr d) es)--> valueExpr d (MultisetQueryCtor q) =-> text "multiset" <> parens (queryExpr d q)--> valueExpr d (MultisetBinOp a c q b) =-> sep-> [valueExpr 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"-> ,valueExpr d b]----> valueExpr _ (CSStringLit cs st) =-> text cs <> quotes (text $ doubleUpQuotes st)--> valueExpr d (Escape v e) =-> valueExpr d v <+> text "escape" <+> text [e]--> valueExpr d (UEscape v e) =-> valueExpr d v <+> text "uescape" <+> text [e]--> valueExpr d (Collate v c) =-> valueExpr d v <+> text "collate" <+> names c--> valueExpr _ (NextValueFor ns) =-> text "next value for" <+> names ns--> valueExpr d (VEComment cmt v) =-> vcat $ map comment cmt ++ [valueExpr d v]--> doubleUpQuotes :: String -> String-> doubleUpQuotes [] = []-> doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs-> doubleUpQuotes (c:cs) = c:doubleUpQuotes cs--> doubleUpDoubleQuotes :: String -> String-> doubleUpDoubleQuotes [] = []-> doubleUpDoubleQuotes ('"':cs) = '"':'"':doubleUpDoubleQuotes cs-> doubleUpDoubleQuotes (c:cs) = c:doubleUpDoubleQuotes cs----> unname :: Name -> String-> unname (QName n) = "\"" ++ doubleUpDoubleQuotes n ++ "\""-> unname (UQName n) = "U&\"" ++ doubleUpDoubleQuotes n ++ "\""-> unname (Name n) = n-> unname (DQName s e n) = s ++ n ++ e--> unnames :: [Name] -> String-> unnames ns = intercalate "." $ map unname ns---> name :: Name -> Doc-> name (QName n) = doubleQuotes $ text $ doubleUpDoubleQuotes n-> name (UQName n) =-> text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n)-> name (Name n) = text n-> name (DQName 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-> ,maybeValueExpr dia "where" wh-> ,grpBy dia gb-> ,maybeValueExpr dia "having" hv-> ,orderBy dia od-> ,me (\e -> text "offset" <+> valueExpr dia e <+> text "rows") off-> ,fetchFirst-> ]-> where-> fetchFirst =-> me (\e -> if dia == MySQL-> then text "limit" <+> valueExpr dia e-> else text "fetch first" <+> valueExpr dia e-> <+> text "rows only") fe--> queryExpr dia (CombineQueryExpr 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) ->-> alias n <+> text "as" <+> parens (queryExpr d q))-> ,queryExpr d qe]-> queryExpr d (Values vs) =-> text "values"-> <+> nest 7 (commaSep (map (parens . commaSep . map (valueExpr 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 -> [(ValueExpr,Maybe Name)] -> Doc-> selectList d is = commaSep $ map si is-> where-> si (e,al) = valueExpr 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 (valueExpr 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]-> 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" <+> valueExpr d e-> joinCond (Just (JoinUsing es)) =-> text "using" <+> parens (commaSep $ map name es)-> joinCond Nothing = empty--> maybeValueExpr :: Dialect -> String -> Maybe ValueExpr -> Doc-> maybeValueExpr d k = me-> (\e -> sep [text k-> ,nest (length k + 1) $ valueExpr 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) = valueExpr 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) =-> valueExpr 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")--= 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 "*/"
+ Language/SQL/SimpleSQL/Syntax.hs view
@@ -0,0 +1,774 @@++-- | 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 *, count(*)+ | Star+ -- | qualified star, as in a.*, b.c.*+ | QStar [Name]++ | 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]+ | QueryExprParens QueryExpr+ | 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] Bool+ | 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 (Maybe TypeName)+ [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+ | ColDefaultClause DefaultClause+ 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,394 +0,0 @@--> -- | The AST for SQL queries.-> {-# LANGUAGE DeriveDataTypeable #-}-> module Language.SQL.SimpleSQL.Syntax-> (-- * Value expressions-> ValueExpr(..)-> ,Name(..)-> ,TypeName(..)-> ,IntervalTypeField(..)-> ,PrecMultiplier(..)-> ,PrecUnits(..)-> ,SetQuantifier(..)-> ,SortSpec(..)-> ,Direction(..)-> ,NullsOrder(..)-> ,InPredValue(..)-> ,SubQueryExprType(..)-> ,CompPredQuantifier(..)-> ,Frame(..)-> ,FrameRows(..)-> ,FramePos(..)-> -- * Query expressions-> ,QueryExpr(..)-> ,makeSelect-> ,CombineOp(..)-> ,Corresponding(..)-> ,Alias(..)-> ,GroupingExpr(..)-> -- ** From-> ,TableRef(..)-> ,JoinType(..)-> ,JoinCondition(..)-> -- * dialect-> ,Dialect(..)-> -- * 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 ValueExpr-> = -- | a numeric literal optional decimal point, e+--> -- integral exponent, e.g-> ---> -- * 10-> ---> -- * 10.-> ---> -- * .1-> ---> -- * 10.1-> ---> -- * 1e5-> ---> -- * 12.34e-6-> NumLit String-> -- | string literal, currently only basic strings between-> -- single quotes with a single quote escaped using ''-> | StringLit String-> -- | text of interval literal, units of interval precision,-> -- e.g. interval 3 days (3)-> | IntervalLit-> {ilSign :: Maybe Bool -- ^ true if + used, false if - used-> ,ilLiteral :: String -- ^ literal text-> ,ilFrom :: IntervalTypeField-> ,ilTo :: Maybe IntervalTypeField-> }-> -- | identifier with parts separated by dots-> | Iden [Name]-> -- | star, as in select *, t.*, count(*)-> | Star-> -- | function application (anything that looks like c style-> -- function application syntactically)-> | App [Name] [ValueExpr]-> -- | aggregate application, which adds distinct or all, and-> -- order by, to regular function application-> | AggregateApp-> {aggName :: [Name] -- ^ aggregate function name-> ,aggDistinct :: SetQuantifier -- ^ distinct-> ,aggArgs :: [ValueExpr]-- ^ args-> ,aggOrderBy :: [SortSpec] -- ^ order by-> ,aggFilter :: Maybe ValueExpr -- ^ filter-> }-> -- | aggregates with within group-> | AggregateAppGroup-> {aggName :: [Name] -- ^ aggregate function name-> ,aggArgs :: [ValueExpr] -- ^ 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 :: [ValueExpr] -- ^ args-> ,wnPartition :: [ValueExpr] -- ^ partition by-> ,wnOrderBy :: [SortSpec] -- ^ order by-> ,wnFrame :: Maybe Frame -- ^ frame clause-> }-> -- | 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 ValueExpr [Name] ValueExpr-> -- | Prefix unary operators. This is used for symbol-> -- operators, keyword operators and multiple keyword operators.-> | PrefixOp [Name] ValueExpr-> -- | Postfix unary operators. This is used for symbol-> -- operators, keyword operators and multiple keyword operators.-> | PostfixOp [Name] ValueExpr-> -- | Used for ternary, mixfix and other non orthodox-> -- operators. Currently used for row constructors, and for-> -- between.-> | SpecialOp [Name] [ValueExpr]-> -- | 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 ValueExpr) [(String,ValueExpr)]-> -- | case expression. both flavours supported-> | Case-> {caseTest :: Maybe ValueExpr -- ^ test value-> ,caseWhens :: [([ValueExpr],ValueExpr)] -- ^ when branches-> ,caseElse :: Maybe ValueExpr -- ^ else value-> }-> | Parens ValueExpr-> -- | cast(a as typename)-> | Cast ValueExpr TypeName-> -- | prefix 'typed literal', e.g. int '42'-> | TypedLit TypeName String-> -- | exists, all, any, some subqueries-> | SubQueryExpr SubQueryExprType QueryExpr-> -- | in list literal and in subquery, if the bool is false it-> -- means not in was used ('a not in (1,2)')-> | In Bool ValueExpr InPredValue-> | Parameter -- ^ Represents a ? 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-> | QuantifiedComparison-> ValueExpr-> [Name] -- operator-> CompPredQuantifier-> QueryExpr-> | Match ValueExpr Bool -- true if unique-> QueryExpr-> | Array ValueExpr [ValueExpr] -- ^ represents an array-> -- access expression, or an array ctor-> -- e.g. a[3]. The first-> -- valueExpr 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)-> | CSStringLit String String-> | Escape ValueExpr Char-> | UEscape ValueExpr Char-> | Collate ValueExpr [Name]-> | MultisetBinOp ValueExpr CombineOp SetQuantifier ValueExpr-> | MultisetCtor [ValueExpr]-> | MultisetQueryCtor QueryExpr-> | NextValueFor [Name]-> | VEComment [Comment] ValueExpr-> deriving (Eq,Show,Read,Data,Typeable)--> -- | Represents an identifier name, which can be quoted or unquoted.-> data Name = Name String-> | QName String-> | UQName String-> | DQName String String String-> -- ^ dialect quoted name, the fields are start quote, end quote and the string itself, e.g. `something` is parsed to DQName "`" "`" "something, and $a$ test $a$ is parsed to DQName "$a$" "$a" " test "-> 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 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 (value expression list)', and 'expr in-> -- (subquery)' syntax.-> data InPredValue = InList [ValueExpr]-> | 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 value 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 ValueExpr 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 ValueExpr-> | Current-> | Following ValueExpr-> | UnboundedFollowing-> 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 :: [(ValueExpr,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 ValueExpr-> ,qeGroupBy :: [GroupingExpr]-> ,qeHaving :: Maybe ValueExpr-> ,qeOrderBy :: [SortSpec]-> ,qeOffset :: Maybe ValueExpr-> ,qeFetchFirst :: Maybe ValueExpr-> }-> | CombineQueryExpr-> {qe0 :: QueryExpr-> ,qeCombOp :: CombineOp-> ,qeSetQuantifier :: SetQuantifier-> ,qeCorresponding :: Corresponding-> ,qe1 :: QueryExpr-> }-> | With-> {qeWithRecursive :: Bool-> ,qeViews :: [(Alias,QueryExpr)]-> ,qeQueryExpression :: QueryExpr}-> | Values [[ValueExpr]]-> | 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 CombineOp = 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 ValueExpr-> 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] [ValueExpr]-> -- | from lateral t-> | TRLateral 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 ValueExpr -- ^ on expr-> | JoinUsing [Name] -- ^ using (column list)-> deriving (Eq,Show,Read,Data,Typeable)---> -- | Used to set the dialect used for parsing and pretty printing,-> -- very unfinished at the moment.-> data Dialect = SQL2011-> | MySQL-> deriving (Eq,Show,Read,Data,Typeable)---> -- | Comment. Useful when generating SQL code programmatically.-> 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,11 +1,86 @@-If you need help updating to a new version of simple-sql-parser,-please email jakewheatmail@gmail.com or use the github bug tracker,-https://github.com/JakeWheat/simple-sql-parser/issues.+0.8.0 lexer has new option to output an invalid token on some kinds of+ parse errors+ switch tests to hspec+ improve parse error messages+ * and x.* changed to only parse in some expression contexts -+ select items and function application argument lists+ support sqlite 'without rowid'+ make types in columndefs optional+ allow column constraints and defaults to be in arbitrary order+ partially support parentheses at query expression level (some nested parens don't parse yet)+0.7.1 fix error message source quoting+0.7.0 support autoincrement for sqlite+ support table constraints without separating comma for sqlite+ switch source from literate to regular haskell+ use megaparsec instead of parsec+ 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+ plus a keyword list, and custom dialects are now feasible+ (still incomplete)+ fix parsing for a lot of things which are keywords in the standard+ fix bug with cte pretty printing an extra 'as', which the parser+ also incorrectly accepted+ bug fix: allow keywords that are quoted to be parsed as identifiers++0.5.0+ update to work with ghc 8.6.5, also tested with 8.4.4 and 8.2.1+ rename some of the modules Lexer -> Lex, Parser -> Parse+ add a separate lexer to simplify code and speed up parsing+ replace SqlIndent with new tool, SimpleSqlParserTool (amazing+ name) which can indent, and parse and lex.+ experiments in new approach to dealing with fixities with separate+ pass after parsing+ dml :add support for insert, update, delete and truncate+ ddl: add limited support for create schema, plus drop schema+ create, alter and drop table with defaults and constraints+ create, alter and drop for domain, view, sequence+ create and drop for assertion+ access control: simple create and drop for role+ simple grant and revoke+ limited support for transaction management: start transation,+ rollback, commit, savepoint+ fix the precendence of operators which was following the weird+ postgresql 9.4 and earlier precendences instead of the standard+ refactor the syntax for names, identifiers and strings slightly+ refactor the dialect support, add some support for postgresql+ syntax+ change parsing of identifiers and strings to not unescape the+ identifier or string text during parsing+ add some explicit parse failures for probably ambiguous text+ */ without /* (outside quoted identifier, string) will fail+ .,e,E following a number without whitespace always fails+ three symbols together fails explicitly, instead of trying to+ lex and giving a less good error at parse time (applies to |+ and : in postgres dialect)+ fix parsing of functions whose name is a keyword (e.g. abs)+ add basic support for parsing odbc syntax ({d 'literals'} {fn+ app(something)} and {oj t1 left outer join ... }+ rename ValueExpr -> ScalarExpr (I think scalar expression is+ slightly less incorrect)+ rename CombineQueryExpr to QueryExprSetOp and CombineOp to SetOperatorName+ use explicit data type for sign in interval literals+ add comments to statement syntax (aimed at codegen)+ add support for oracle type size units 'char' and 'byte', example: varchar2(55 byte)+ updated the makefile to use cabal v2 commands+ fix for parsing window functions with keyword names 0.4.4 tested with ghc 8.2.1 and 8.4.3 0.4.3 tested with ghc 8.0.2 and 8.2.1-0.4.1 (commit TBD)+0.4.1 (commit c156c5c34e91e1f7ef449d2c1ea14e282104fd90) tested with ghc 7.4.2, 7.6.3, 7.8.4,7.10.0.20150123 simple demonstration of how dialects could be handled internally add ability to add comments to syntax tree to help with generating
+ examples/SimpleSQLParserTool.hs view
@@ -0,0 +1,106 @@++{-+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+ -- exit with 0 in this case+ showHelp Nothing -- $ 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 False (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,100 +1,106 @@+cabal-version: 2.2+ name: simple-sql-parser-version: 0.4.4-synopsis: A parser for SQL queries+version: 0.8.0+synopsis: A parser for SQL. -description: A parser for SQL queries. Parses most SQL:2011- queries. Please see the homepage for more information+description: A parser for SQL. Parses most SQL:2011+ queries, non-query DML, DDL, access control and+ transaction management syntax. Please see the+ homepage for more information <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+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 type: git location: https://github.com/JakeWheat/simple-sql-parser.git -Flag sqlindent- Description: Build SQLIndent exe+Flag parserexe+ Description: Build SimpleSQLParserTool exe Default: False -library- exposed-modules: Language.SQL.SimpleSQL.Pretty,- Language.SQL.SimpleSQL.Parser,- Language.SQL.SimpleSQL.Syntax- Other-Modules: Language.SQL.SimpleSQL.Errors,- Language.SQL.SimpleSQL.Combinators- other-extensions: TupleSections- build-depends: base >=4 && <5,- parsec >=3.1 && <3.2,- mtl >=2.1 && <2.3,- pretty >= 1.1 && < 1.2- -- hs-source-dirs:+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- other-extensions: TupleSections,DeriveDataTypeable+ +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 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,-- HUnit >= 1.2 && < 1.7,- test-framework >= 0.8 && < 0.9,- test-framework-hunit >= 0.3 && < 0.4-- Other-Modules: Language.SQL.SimpleSQL.Pretty,- Language.SQL.SimpleSQL.Parser,- Language.SQL.SimpleSQL.Syntax,- Language.SQL.SimpleSQL.Errors,- Language.SQL.SimpleSQL.Combinators+ main-is: RunTests.hs+ hs-source-dirs: tests+ Build-Depends: simple-sql-parser,+ hspec,+ hspec-megaparsec,+ hspec-expectations,+ raw-strings-qq,+ hspec-golden,+ filepath,+ pretty-show, - --Language.SQL.SimpleSQL.ErrorMessages,+ Other-Modules: Language.SQL.SimpleSQL.ErrorMessages, Language.SQL.SimpleSQL.FullQueries, Language.SQL.SimpleSQL.GroupBy, Language.SQL.SimpleSQL.MySQL, Language.SQL.SimpleSQL.Postgres,+ Language.SQL.SimpleSQL.Odbc,+ Language.SQL.SimpleSQL.Oracle, Language.SQL.SimpleSQL.QueryExprComponents, Language.SQL.SimpleSQL.QueryExprs,- Language.SQL.SimpleSQL.SQL2011,+ Language.SQL.SimpleSQL.QueryExprParens,+ Language.SQL.SimpleSQL.SQL2011Queries,+ Language.SQL.SimpleSQL.SQL2011AccessControl,+ Language.SQL.SimpleSQL.SQL2011Bits,+ Language.SQL.SimpleSQL.SQL2011DataManipulation,+ Language.SQL.SimpleSQL.SQL2011Schema, Language.SQL.SimpleSQL.TableRefs, Language.SQL.SimpleSQL.TestTypes, Language.SQL.SimpleSQL.Tests, Language.SQL.SimpleSQL.Tpch,- Language.SQL.SimpleSQL.ValueExprs-- other-extensions: TupleSections,DeriveDataTypeable- default-language: Haskell2010- ghc-options: -Wall+ Language.SQL.SimpleSQL.ScalarExprs,+ Language.SQL.SimpleSQL.LexerTests,+ Language.SQL.SimpleSQL.CustomDialect,+ Language.SQL.SimpleSQL.EmptyStatement,+ Language.SQL.SimpleSQL.CreateIndex+ Language.SQL.SimpleSQL.Expectations+ Language.SQL.SimpleSQL.TestRunners+ + ghc-options: -threaded -executable SQLIndent- main-is: SQLIndent.lhs- hs-source-dirs: .,tools- Other-Modules: Language.SQL.SimpleSQL.Pretty,- Language.SQL.SimpleSQL.Parser,- Language.SQL.SimpleSQL.Syntax,- 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- other-extensions: TupleSections,DeriveDataTypeable- default-language: Haskell2010- ghc-options: -Wall- if flag(sqlindent)+-- this is a testing tool, do some dumb stuff to hide the dependencies in hackage+Test-Suite SimpleSQLParserTool+ import: shared-properties+ type: exitcode-stdio-1.0+ main-is: SimpleSQLParserTool.hs+ hs-source-dirs: examples+ Build-Depends: simple-sql-parser,+ pretty-show >= 1.6 && < 1.10+ if flag(parserexe) buildable: True else buildable: False+
+ tests/Language/SQL/SimpleSQL/CreateIndex.hs view
@@ -0,0 +1,22 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.CreateIndex where++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++createIndexTests :: TestItem+createIndexTests = Group "create index tests"+ [s "create index a on tbl(c1)"+ $ CreateIndex False [nm "a"] [nm "tbl"] [nm "c1"]+ ,s "create index a.b on sc.tbl (c1, c2)"+ $ CreateIndex False [nm "a", nm "b"] [nm "sc", nm "tbl"] [nm "c1", nm "c2"]+ ,s "create unique index a on tbl(c1)"+ $ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]+ ]+ where+ nm = Name Nothing+ s :: HasCallStack => Text -> Statement -> TestItem+ s src ast = testStatement ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/CustomDialect.hs view
@@ -0,0 +1,32 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++customDialectTests :: TestItem+customDialectTests = Group "custom dialect tests" $+ [q ansi2011 "SELECT a b"+ ,q noDateKeyword "SELECT DATE('2000-01-01')"+ ,q noDateKeyword "SELECT DATE"+ ,q dateApp "SELECT DATE('2000-01-01')"+ ,q dateIden "SELECT DATE"+ ,f ansi2011 "SELECT DATE('2000-01-01')"+ ,f ansi2011 "SELECT DATE"+ ,f dateApp "SELECT DATE"+ ,f dateIden "SELECT DATE('2000-01-01')"+ -- show this never being allowed as an alias+ ,f ansi2011 "SELECT a date"+ ,f dateApp "SELECT a date"+ ,f dateIden "SELECT a date"+ ]+ where+ noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}+ dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}+ dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}+ q :: HasCallStack => Dialect -> Text -> TestItem+ q d src = testParseQueryExpr d src+ f :: HasCallStack => Dialect -> Text -> TestItem+ f d src = testParseQueryExprFails d src
+ tests/Language/SQL/SimpleSQL/EmptyStatement.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.EmptyStatement where++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++emptyStatementTests :: TestItem+emptyStatementTests = Group "empty statement"+ [ s ";" EmptyStatement+ , t ";" [EmptyStatement]+ , t ";;" [EmptyStatement, EmptyStatement]+ , t ";;;" [EmptyStatement, EmptyStatement, EmptyStatement]+ , s "/* comment */ ;" EmptyStatement+ , t "" []+ , t "/* comment */" []+ , t "/* comment */ ;" [EmptyStatement]+ , t "/* comment */ ; /* comment */ ;"+ [EmptyStatement, EmptyStatement]+ , t "/* comment */ ; /* comment */ ; /* comment */ ;"+ [EmptyStatement, EmptyStatement, EmptyStatement]+ ]+ where+ s :: HasCallStack => Text -> Statement -> TestItem+ s src a = testStatement ansi2011 src a+ t :: HasCallStack => Text -> [Statement] -> TestItem+ t src a = testStatements ansi2011 src a
+ tests/Language/SQL/SimpleSQL/ErrorMessages.hs view
@@ -0,0 +1,697 @@++{-++Quick tests for error messages, all the tests use the entire formatted+output of parse failures to compare, it's slightly fragile. Most of+the tests use a huge golden file which contains tons of parse error+examples.++-}+++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Language.SQL.SimpleSQL.ErrorMessages+ (errorMessageTests+ ) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Parse+import qualified Language.SQL.SimpleSQL.Lex as L+import Language.SQL.SimpleSQL.TestRunners+--import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.Expectations+import Test.Hspec (it)+import Debug.Trace++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Test.Hspec.Golden+ (Golden(..)+ )++import qualified Text.RawString.QQ as R+import System.FilePath ((</>))+import Text.Show.Pretty (ppShow)++errorMessageTests :: TestItem+errorMessageTests = Group "error messages"+ [gp (parseQueryExpr ansi2011 "" Nothing) prettyError [R.r|++select+a+from t+where+ something+order by 1,2,3 where++ |]+ [R.r|8:16:+ |+8 | order by 1,2,3 where+ | ^^^^^+unexpected where+|]+ ,gp (L.lexSQL ansi2011 False "" Nothing) L.prettyError [R.r|+ +select+a+from t+where+ something+order by 1,2,3 $@++ |]+ [R.r|8:16:+ |+8 | order by 1,2,3 $@+ | ^+unexpected '$'+|]+ ,let fn = "expected-parse-errors"+ got = generateParseResults parseErrorData+ in GoldenErrorTest fn parseErrorData $ it "parse error regressions" $ myGolden (T.unpack fn) got+ ]+ where+ gp :: (Show a, HasCallStack) => (Text -> Either e a) -> (e -> Text) -> Text -> Text -> TestItem+ gp parse pret src err =+ GeneralParseFailTest src err $+ it (T.unpack src) $+ let f1 = parse src+ ex = shouldFailWith pret+ quickTrace =+ case f1 of+ Left f | pret f /= err ->+ trace (T.unpack ("check\n[" <> pret f <>"]\n["<> err <> "]\n"))+ _ -> id+ in quickTrace (f1 `ex` err)++------------------------------------------------------------------------------++-- golden parse error tests+ +myGolden :: String -> Text -> Golden Text+myGolden name actualOutput =+ Golden {+ output = actualOutput,+ encodePretty = show,+ writeToFile = T.writeFile,+ readFromFile = T.readFile,+ goldenFile = name </> "golden",+ actualFile = Just (name </> "actual"),+ failFirstTime = False+ }++parseErrorData :: [(Text,Text,Text)]+parseErrorData =+ concat+ [simpleExpressions1+ ,pgExprs+ ,sqlServerIden+ ,mysqliden+ ,paramvariations+ ,odbcexpr+ ,odbcqexpr+ ,queryExprExamples+ ,statementParseErrorExamples]++generateParseResults :: [(Text,Text,Text)] -> Text+generateParseResults dat =+ let testLine (parser,dialect,src) =+ let d = case dialect of+ "ansi2011" -> ansi2011+ "postgres" -> postgres+ "sqlserver" -> sqlserver+ "mysql" -> mysql+ "params" -> ansi2011{diAtIdentifier=True, diHashIdentifier= True}+ "odbc" -> ansi2011{diOdbc=True}+ _ -> error $ "unknown dialect: " <> T.unpack dialect+ res = case parser of+ "queryExpr" ->+ either prettyError (T.pack . ppShow)+ $ parseQueryExpr d "" Nothing src+ "scalarExpr" ->+ either prettyError (T.pack . ppShow)+ $ parseScalarExpr d "" Nothing src+ "statement" ->+ either prettyError (T.pack . ppShow)+ $ parseStatement d "" Nothing src+ _ -> error $ "unknown parser: " <> T.unpack parser+ -- prepend a newline to multi line fields, so they show+ -- nice in a diff in meld or similar+ resadj = if '\n' `T.elem` res+ then T.cons '\n' res+ else res+ in T.unlines [parser, dialect, src, resadj]+ in T.unlines $ map testLine dat++parseExampleStrings :: Text -> [Text]+parseExampleStrings = filter (not . T.null) . map T.strip . T.splitOn ";"++simpleExpressions1 :: [(Text,Text,Text)]+simpleExpressions1 =+ concat $ flip map (parseExampleStrings simpleExprData) $ \e ->+ [("scalarExpr", "ansi2011", e)+ ,("queryExpr", "ansi2011", "select " <> e)+ ,("queryExpr", "ansi2011", "select " <> e <> ",")+ ,("queryExpr", "ansi2011", "select " <> e <> " from")]+ where+ simpleExprData = [R.r|+'test+;+'test''t+;+'test''+;+3.23e-+;+.+;+3.23e+;+a.3+;+3.a+;+3.2a+;+4iden+;+4iden.+;+iden.4iden+;+4iden.*+;+from+;+from.a+;+a.from+;+not+;+4 ++;+4 + from+;+(5+;+(5 ++;+(5 + 6+;+(5 + from)+;+case+;+case a+;+case a when b c end+;+case a when b then c+;+case a else d end+;+case a from c end+;+case a when from then to end+;+/* blah+;+/* blah /* stuff */+;+/* *+;+/* /+;+$$something$+;+$$something+;+$$something+x+;+$a$something$b$+;+$a$+;+'''+;+'''''+;+"a+;+"a""+;+"""+;+"""""+;+""+;+*/+;+:3+;+@3+;+#3+;+:::+;+|||+;+...+;+"+;+]+;+)+;+[test+;+[]+;+[[test]]+;+`open+;+```+;+``+;+}+;+mytype(4 '4';+;+app(3+;+app(+;+app(something+;+app(something,+;+count(*+;+count(* filter (where something > 5)+;+count(*) filter (where something > 5+;+count(*) filter (+;+sum(a over (order by b)+;+sum(a) over (order by b+;+sum(a) over (+;+rank(a,c within group (order by b)+;+rank(a,c) within group (order by b+;+rank(a,c) within group (+;+array[+;+(a+;+(+;+a >*+;+a >* b+;+( ( a+;+( ( a )+;+( ( a + )+|]++pgExprs :: [(Text,Text,Text)]+pgExprs = flip map (parseExampleStrings src) $ \e ->+ ("scalarExpr", "postgres", e)+ where src = [R.r|+$$something$+;+$$something+;+$$something+x+;+$a$something$b$+;+$a$+;+:::+;+|||+;+...+;++|]++sqlServerIden :: [(Text,Text,Text)]+sqlServerIden = flip map (parseExampleStrings src) $ \e ->+ ("scalarExpr", "sqlserver", e)+ where src = [R.r|+]+;+[test+;+[]+;+[[test]]++|]++mysqliden :: [(Text,Text,Text)]+mysqliden = flip map (parseExampleStrings src) $ \e ->+ ("scalarExpr", "mysql", e)+ where src = [R.r|+`open+;+```+;+``++|]++paramvariations :: [(Text,Text,Text)]+paramvariations = flip map (parseExampleStrings src) $ \e ->+ ("scalarExpr", "params", e)+ where src = [R.r|+:3+;+@3+;+#3++|]+++odbcexpr :: [(Text,Text,Text)]+odbcexpr = flip map (parseExampleStrings src) $ \e ->+ ("scalarExpr", "odbc", e)+ where src = [R.r|+{d '2000-01-01'+;+{fn CHARACTER_LENGTH(string_exp)++|]++odbcqexpr :: [(Text,Text,Text)]+odbcqexpr = flip map (parseExampleStrings src) $ \e ->+ ("queryExpr", "odbc", e)+ where src = [R.r|+select * from {oj t1 left outer join t2 on expr++|]+++ +queryExprExamples :: [(Text,Text,Text)]+queryExprExamples = flip map (parseExampleStrings src) $ \e ->+ ("queryExpr", "ansi2011", e)+ where src = [R.r|+select a select+;+select a from t,+;+select a from t select+;+select a from t(a)+;+select a from (t+;+select a from (t having+;+select a from t a b+;+select a from t as+;+select a from t as having+;+select a from (1234)+;+select a from (1234+;+select a from a wrong join b+;+select a from a natural wrong join b+;+select a from a left wrong join b+;+select a from a left wrong join b+;+select a from a join b select+;+select a from a join b on select+;+select a from a join b on (1234+;+select a from a join b using(a+;+select a from a join b using(a,+;+select a from a join b using(a,)+;+select a from a join b using(1234+;+select a from t order no a+;+select a from t order by a where c+;+select 'test+'+;+select a as+;+select a as from t+;+select a as, +;+select a,+;+select a, from t+;+select a as from+;+select a as from from+;+select a as from2 from+;+select a fromt+;+select a b fromt++;+select a from t u v+;+select a from t as+;+select a from t, +;+select a from group by b+;+select a from t join group by a+;+select a from t join+;+select a from (@+;+select a from ()+;+select a from t left join u on+;+select a from t left join u on group by a+;+select a from t left join u using+;+select a from t left join u using (+;+select a from t left join u using (a+;+select a from t left join u using (a,+;+select a from (select a from)+;+select a from (select a++;+select a from t where+;+select a from t group by a having b where+;+select a from t where (a+;+select a from t where group by b++;+select a from t group by+;+select a from t group+;+select a from t group by a as+;+select a from t group by a,+;+select a from t group by order by+;+select a <<== b from t+;+/*+;+select * as a+;+select t.* as a+;+select 3 + *+;+select case when * then 1 end+;+select (*)+;+select * from (select a+ from t+;+select * from (select a(stuff)+ from t++;+select *+ from (select a,b+ from t+ where a = 1+ and b > a++;+select *+ from (select a,b+ from t+ where a = 1+ and b > a+ from t)++|]+++statementParseErrorExamples :: [(Text,Text,Text)]+statementParseErrorExamples = flip map (parseExampleStrings src) $ \e ->+ ("statement", "ansi2011", e)+ where src = [R.r|+create+;+drop+;+delete this+;+delete where 7+;+delete from where t+;+truncate nothing+;+truncate nothing nothing+;+truncate table from+;+truncate table t u+;+insert t select u+;+insert into t insert+;+insert into t (1,2)+;+insert into t(+;+insert into t(1+;+insert into t(a+;+insert into t(a,+;+insert into t(a,b)+;+insert into t(a,b) values+;+insert into t(a,b) values (+;+insert into t(a,b) values (1+;+insert into t(a,b) values (1,+;+insert into t(a,b) values (1,2) and stuff+;+update set 1+;+update t u+;+update t u v+;+update t set a+;+update t set a=+;+update t set a=1,+;+update t set a=1 where+;+update t set a=1 where 1 also+;+create table+;+create table t (+ a+)+;+create table t (+ a+;+create table t (+ a,+)+;+create table t (+)+;+create table t (+;+create table t+;+create table t. (+;+truncate table t.+;+drop table t. where+;+update t. set+;+delete from t. where+;+insert into t. values+;+with a as (select * from t+select 1+;+with a as (select * from t+;+with a as (+;+with a (+;+with as (select * from t)+select 1+;+with (select * from t) as a+select 1+++|]+
+ tests/Language/SQL/SimpleSQL/Expectations.hs view
@@ -0,0 +1,61 @@++module Language.SQL.SimpleSQL.Expectations+ (shouldParseA+ ,shouldParseL+ ,shouldParse1+ ,shouldFail+ ,shouldSucceed+ ,shouldFailWith+ ) where+++import Language.SQL.SimpleSQL.Parse+import qualified Language.SQL.SimpleSQL.Lex as Lex++import qualified Data.Text as T+import Data.Text (Text)++import Test.Hspec.Expectations+ (Expectation+ ,HasCallStack+ ,expectationFailure+ )++import Test.Hspec+ (shouldBe+ )++shouldParseA :: (HasCallStack,Eq a, Show a) => Either ParseError a -> a -> Expectation+shouldParseA = shouldParse1 (T.unpack . prettyError)++shouldParseL :: (HasCallStack,Eq a, Show a) => Either Lex.ParseError a -> a -> Expectation+shouldParseL = shouldParse1 (T.unpack . Lex.prettyError)++shouldParse1 :: (HasCallStack, Show a, Eq a) =>+ (e -> String)+ -> Either e a+ -> a+ -> Expectation +shouldParse1 prettyErr r v = case r of+ Left e ->+ expectationFailure $+ "expected: "+ ++ show v+ ++ "\nbut parsing failed with error:\n"+ ++ prettyErr e+ Right x -> x `shouldBe` v++shouldFail :: (HasCallStack, Show a) => Either e a -> Expectation +shouldFail r = case r of+ Left _ -> (1 :: Int) `shouldBe` 1+ Right a -> expectationFailure $ "expected parse failure, but succeeded with " <> show a++shouldFailWith :: (HasCallStack, Show a) => (e -> Text) -> Either e a -> Text -> Expectation +shouldFailWith p r e = case r of+ Left e1 -> p e1 `shouldBe` e+ Right a -> expectationFailure $ "expected parse failure, but succeeded with " <> show a++shouldSucceed :: (HasCallStack) => (e -> String) -> Either e a -> Expectation+shouldSucceed pe r = case r of+ Left e -> expectationFailure $ "expected parse success, but got: " <> pe e+ Right _ -> (1 :: Int) `shouldBe` 1
+ tests/Language/SQL/SimpleSQL/FullQueries.hs view
@@ -0,0 +1,43 @@++-- 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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++fullQueriesTests :: TestItem+fullQueriesTests = Group "queries" $+ [q "select count(*) from t"+ $ toQueryExpr $ makeSelect+ {msSelectList = [(App [Name Nothing "count"] [Star], Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }++ ,q "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]+ }+ + ]+ where+ q :: HasCallStack => Text -> QueryExpr -> TestItem+ q src a = testQueryExpr ansi2011 src a
+ tests/Language/SQL/SimpleSQL/GroupBy.hs view
@@ -0,0 +1,248 @@++-- 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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)+++groupByTests :: TestItem+groupByTests = Group "groupByTests"+ [simpleGroupBy+ ,newGroupBy+ ,randomGroupBy+ ]++q :: HasCallStack => Text -> QueryExpr -> TestItem+q src a = testQueryExpr ansi2011 src a++p :: HasCallStack => Text -> TestItem+p src = testParseQueryExpr ansi2011 src++++simpleGroupBy :: TestItem+simpleGroupBy = Group "simpleGroupBy"+ [q "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"]]+ }++ ,q "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"+ [q "select * from t group by ()" $ ms [GroupingParens []]+ ,q "select * from t group by grouping sets ((), (a))"+ $ ms [GroupingSets [GroupingParens []+ ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]]+ ,q "select * from t group by cube(a,b)"+ $ ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]]+ ,q "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"+ [p "select * from t GROUP BY a"+ ,p "select * from t GROUP BY GROUPING SETS((a))"+ ,p "select * from t GROUP BY a,b,c"+ ,p "select * from t GROUP BY GROUPING SETS((a,b,c))"+ ,p "select * from t GROUP BY ROLLUP(a,b)"+ ,p "select * from t GROUP BY GROUPING SETS((a,b),\n\+ \(a),\n\+ \() )"+ ,p "select * from t GROUP BY ROLLUP(b,a)"+ ,p "select * from t GROUP BY GROUPING SETS((b,a),\n\+ \(b),\n\+ \() )"+ ,p "select * from t GROUP BY CUBE(a,b,c)"+ ,p "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\+ \() )"+ ,p "select * from t GROUP BY ROLLUP(Province, County, City)"+ ,p "select * from t GROUP BY ROLLUP(Province, (County, City))"+ ,p "select * from t GROUP BY ROLLUP(Province, (County, City))"+ ,p "select * from t GROUP BY GROUPING SETS((Province, County, City),\n\+ \(Province),\n\+ \() )"+ ,p "select * from t GROUP BY GROUPING SETS((Province, County, City),\n\+ \(Province, County),\n\+ \(Province),\n\+ \() )"+ ,p "select * from t GROUP BY a, ROLLUP(b,c)"+ ,p "select * from t GROUP BY GROUPING SETS((a,b,c),\n\+ \(a,b),\n\+ \(a) )"+ ,p "select * from t GROUP BY a, b, ROLLUP(c,d)"+ ,p "select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\+ \(a,b,c),\n\+ \(a,b) )"+ ,p "select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"+ ,p "select * from t GROUP BY GROUPING SETS((a,b,c),\n\+ \(a,b),\n\+ \(a),\n\+ \(b,c),\n\+ \(b),\n\+ \() )"+ ,p "select * from t GROUP BY ROLLUP(a), CUBE(b,c)"+ ,p "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\+ \() )"+ ,p "select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"+ ,p "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\+ \() )"+ ,p "select * from t GROUP BY a, ROLLUP(a,b)"+ ,p "select * from t GROUP BY GROUPING SETS((a,b),\n\+ \(a) )"+ ,p "select * from t GROUP BY Region,\n\+ \ROLLUP(Sales_Person, WEEK(Sales_Date)),\n\+ \CUBE(YEAR(Sales_Date), MONTH (Sales_Date))"+ ,p "select * from t GROUP BY ROLLUP (Region, Sales_Person, WEEK(Sales_Date),\n\+ \YEAR(Sales_Date), MONTH(Sales_Date) )"++ ,p "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"++ ,p "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"++ ,p "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"++ ,p "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"++ ,p "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"++ ,p "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"++ ,p "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"++ ,p "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"++ ,p "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"++ {-,p "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+ ,p "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,428 @@+++-- 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 Language.SQL.SimpleSQL.TestRunners++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" $+ [t "iden" [Identifier Nothing "iden"]++ ,t "\"a1normal \"\" iden\"" [Identifier (Just ("\"","\"")) "a1normal \"\" iden"]++ ,t "'string'" [SqlString "'" "'" "string"]++ ,t " " [Whitespace " "]+ ,t "\t " [Whitespace "\t "]+ ,t " \n " [Whitespace " \n "]+ + ,t "--" [LineComment "--"]+ ,t "--\n" [LineComment "--\n"]+ ,t "--stuff" [LineComment "--stuff"]+ ,t "-- stuff" [LineComment "-- stuff"]+ ,t "-- stuff\n" [LineComment "-- stuff\n"]+ ,t "--\nstuff" [LineComment "--\n", Identifier Nothing "stuff"]+ ,t "-- com \nstuff" [LineComment "-- com \n", Identifier Nothing "stuff"]++ ,t "/*test1*/" [BlockComment "/*test1*/"]+ ,t "/**/" [BlockComment "/**/"]+ ,t "/***/" [BlockComment "/***/"]+ ,t "/* * */" [BlockComment "/* * */"]+ ,t "/*test*/" [BlockComment "/*test*/"]+ ,t "/*te/*st*/*/" [BlockComment "/*te/*st*/*/"]+ ,t "/*te*st*/" [BlockComment "/*te*st*/"]+ ,t "/*lines\nmore lines*/" [BlockComment "/*lines\nmore lines*/"]+ ,t "/*test1*/\n" [BlockComment "/*test1*/", Whitespace "\n"]+ ,t "/*test1*/stuff" [BlockComment "/*test1*/", Identifier Nothing "stuff"]++ ,t "1" [SqlNumber "1"]+ ,t "42" [SqlNumber "42"]++ ,tp "$1" [PositionalArg 1]+ ,tp "$200" [PositionalArg 200]++ ,t ":test" [PrefixedVariable ':' "test"]+ + ] ++ map (\a -> t a [Symbol a]) (+ ["!=", "<>", ">=", "<=", "||"]+ ++ map T.singleton ("(),-+*/<>=." :: [Char]))+ where+ t :: HasCallStack => Text -> [Token] -> TestItem+ t src ast = testLex ansi2011 src ast+ tp :: HasCallStack => Text -> [Token] -> TestItem+ tp src ast = testLex ansi2011{diPositionalArg=True} src ast+++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+ ++ [("\"anormal \"\" iden\"", [Identifier (Just ("\"","\"")) "anormal \"\" 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" $ [l s t | (s,t) <- ansiLexerTable]+ ,Group "ansi generated combination lexer tests" $+ [ l (s <> s1) (t <> t1)+ | (s,t) <- ansiLexerTable+ , (s1,t1) <- ansiLexerTable+ , tokenListWillPrintAndLex ansi2011 $ t <> t1++ ]+ ,Group "ansiadhoclexertests" $+ [l "" []+ ,l "-- line com\nstuff" [LineComment "-- line com\n",Identifier Nothing "stuff"]+ ] +++ [-- want to make sure this gives a parse error+ f "*/"+ -- 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+ ,f "|||"+ ,f "||||"+ ,f "|||||"+ -- 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+ ,f "12e3e4"+ ,f "12e3e4"+ ,f "12e3e4"+ ,f "12e3.4"+ ,f "12.4.5"+ ,f "12.4e5.6"+ ,f "12.4e5e7"]+ ]+ where+ l :: HasCallStack => Text -> [Token] -> TestItem+ l src ast = testLex ansi2011 src ast+ f :: HasCallStack => Text -> TestItem+ f src = lexFails ansi2011 src+++{-+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" $+ [l s t | (s,t) <- postgresLexerTable]+ ,Group "postgres generated lexer token tests" $+ [l s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]+ ,Group "postgres generated combination lexer tests" $+ [ l (s <> s1) (t <> t1)+ | (s,t) <- postgresLexerTable ++ postgresShortOperatorTable+ , (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable+ , tokenListWillPrintAndLex postgres $ t ++ t1++ ]+ ,Group "generated postgres edgecase lexertests" $+ [l 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+ [f "*/"+ ,f ":::"+ ,f "::::"+ ,f ":::::"+ ,f "@*/"+ ,f "-*/"+ ,f "12e3e4"+ ,f "12e3e4"+ ,f "12e3e4"+ ,f "12e3.4"+ ,f "12.4.5"+ ,f "12.4e5.6"+ ,f "12.4e5e7"+ -- special case allow this to lex to 1 .. 2+ -- this is for 'for loops' in plpgsql+ ,l "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 "/**/"])+ ]+ l :: HasCallStack => Text -> [Token] -> TestItem+ l src ast = testLex postgres src ast+ f :: HasCallStack => Text -> TestItem+ f src = lexFails postgres src++sqlServerLexerTests :: TestItem+sqlServerLexerTests = Group "sqlServerLexTests" $+ [l s t | (s,t) <-+ [("@variable", [(PrefixedVariable '@' "variable")])+ ,("#variable", [(PrefixedVariable '#' "variable")])+ ,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])+ ]]+ where+ l :: HasCallStack => Text -> [Token] -> TestItem+ l src ast = testLex sqlserver src ast++oracleLexerTests :: TestItem+oracleLexerTests = Group "oracleLexTests" $+ [] -- nothing oracle specific atm++mySqlLexerTests :: TestItem+mySqlLexerTests = Group "mySqlLexerTests" $+ [ l s t | (s,t) <-+ [("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])+ ]+ ]+ where+ l :: HasCallStack => Text -> [Token] -> TestItem+ l src ast = testLex mysql src ast++odbcLexerTests :: TestItem+odbcLexerTests = Group "odbcLexTests" $+ [ lo s t | (s,t) <-+ [("{}", [Symbol "{", Symbol "}"])+ ]]+ ++ [lno "{"+ ,lno "}"]+ where+ lo :: HasCallStack => Text -> [Token] -> TestItem+ lo src ast = testLex (sqlserver {diOdbc = True}) src ast+ lno :: HasCallStack => Text -> TestItem+ lno src = lexFails (sqlserver{diOdbc = False}) src+++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,39 @@++-- Tests for mysql dialect parsing++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.MySQL (mySQLTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestRunners++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"+ [testScalarExpr mysql "`test`" $ Iden [Name (Just ("`","`")) "test"]+ ,testParseScalarExprFails ansi2011 "`test`"]++limit :: TestItem+limit = Group "queries"+ [testQueryExpr mysql "select * from t limit 5"+ $ toQueryExpr $ sel {msFetchFirst = Just (NumLit "5")}+ ,testParseQueryExprFails mysql "select a from t fetch next 10 rows only;"+ ,testParseQueryExprFails 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,60 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Odbc (odbcTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++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" [+ q+ "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" [+ q+ "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 :: HasCallStack => Text -> ScalarExpr -> TestItem+ e src ast = testScalarExpr ansi2011{diOdbc = True} src ast++ q :: HasCallStack => Text -> QueryExpr -> TestItem+ q src ast = testQueryExpr ansi2011{diOdbc = True} src ast++ --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,32 @@++-- Tests for oracle dialect parsing++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.Oracle (oracleTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestRunners++oracleTests :: TestItem+oracleTests = Group "oracle dialect"+ [oracleLobUnits]+++oracleLobUnits :: TestItem+oracleLobUnits = Group "oracleLobUnits"+ [testScalarExpr oracle "cast (a as varchar2(3 char))"+ $ Cast (Iden [Name Nothing "a"]) (+ PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters))+ ,testScalarExpr oracle "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")+ (Just (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets)))+ []]+ False+ ]+
+ tests/Language/SQL/SimpleSQL/Postgres.hs view
@@ -0,0 +1,284 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++postgresTests :: TestItem+postgresTests = Group "postgresTests"++{-+lexical syntax section++TODO: get all the commented out tests working+-}++ [-- "SELECT 'foo'\n\+ -- \'bar';" -- this should parse as select 'foobar'+ -- ,+ t "SELECT name, (SELECT max(pop) FROM cities\n\+ \ WHERE cities.state = states.name)\n\+ \ FROM states;"+ ,t "SELECT ROW(1,2.5,'this is a test');"++ ,t "SELECT ROW(t.*, 42) FROM t;"+ ,t "SELECT ROW(t.f1, t.f2, 42) FROM t;"+ ,t "SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));"++ ,t "SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');"++ -- table is a reservered keyword?+ --,t "SELECT ROW(table.*) IS NULL FROM table;"+ ,t "SELECT ROW(tablex.*) IS NULL FROM tablex;"++ ,t "SELECT true OR somefunc();"++ ,t "SELECT somefunc() OR true;"++-- queries section++ ,t "SELECT * FROM t1 CROSS JOIN t2;"+ ,t "SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"+ ,t "SELECT * FROM t1 INNER JOIN t2 USING (num);"+ ,t "SELECT * FROM t1 NATURAL INNER JOIN t2;"+ ,t "SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"+ ,t "SELECT * FROM t1 LEFT JOIN t2 USING (num);"+ ,t "SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"+ ,t "SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"+ ,t "SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"+ ,t "SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"++ ,t "SELECT * FROM some_very_long_table_name s\n\+ \JOIN another_fairly_long_name a ON s.id = a.num;"+ ,t "SELECT * FROM people AS mother JOIN people AS child\n\+ \ ON mother.id = child.mother_id;"+ ,t "SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"+ ,t "SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"+ ,t "SELECT * FROM getfoo(1) AS t1;"+ ,t "SELECT * FROM foo\n\+ \ WHERE foosubid IN (\n\+ \ SELECT foosubid\n\+ \ FROM getfoo(foo.fooid) z\n\+ \ WHERE z.fooid = foo.fooid\n\+ \ );"+ {-,t "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??++ ,t "SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"+ ,t "SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"++ {-,t "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?++ {-,t "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;"-}++ ,t "SELECT m.name\n\+ \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true\n\+ \WHERE pname IS NULL;"+++ ,t "SELECT * FROM fdt WHERE c1 > 5"++ ,t "SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"++ ,t "SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"++ ,t "SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"++ ,t "SELECT * FROM fdt WHERE c1 BETWEEN \n\+ \ (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100"++ ,t "SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"++ ,t "SELECT * FROM test1;"++ ,t "SELECT x FROM test1 GROUP BY x;"+ ,t "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+ ,t "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;"++ ,t "SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"+ ,t "SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"+ ,t "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;"++ ,t "SELECT a, b, c FROM t"++ ,t "SELECT tbl1.a, tbl2.a, tbl1.b FROM t"++ ,t "SELECT tbl1.*, tbl2.a FROM t"++ ,t "SELECT a AS value, b + c AS sum FROM t"++ ,t "SELECT a \"value\", b + c AS sum FROM t"++ ,t "SELECT DISTINCT select_list t"++ ,t "VALUES (1, 'one'), (2, 'two'), (3, 'three');"++ ,t "SELECT 1 AS column1, 'one' AS column2\n\+ \UNION ALL\n\+ \SELECT 2, 'two'\n\+ \UNION ALL\n\+ \SELECT 3, 'three';"++ ,t "SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"++ ,t "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;"++ ,t "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"++ ,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"++ ,t "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;"++ {-,t "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++ {-,t "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++ ,t "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++ ,t "SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\+ \ FROM distributors d, films f\n\+ \ WHERE f.did = d.did"++ ,t "SELECT kind, sum(len) AS total\n\+ \ FROM films\n\+ \ GROUP BY kind\n\+ \ HAVING sum(len) < interval '5 hours';"++ ,t "SELECT * FROM distributors ORDER BY name;"+ ,t "SELECT * FROM distributors ORDER BY 2;"++ ,t "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%';"++ ,t "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"++ ,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;"++ ,t "SELECT m.name AS mname, pname\n\+ \FROM manufacturers m, LATERAL get_product_names(m.id) pname;"++ ,t "SELECT m.name AS mname, pname\n\+ \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"++ ,t "SELECT 2+2;"++ -- simple-sql-parser doesn't support where without from+ -- this can be added for the postgres dialect when it is written+ --,t "SELECT distributors.* WHERE distributors.name = 'Westward';"++ ]+ where+ t :: HasCallStack => Text -> TestItem+ t src = testParseQueryExpr postgres src
+ tests/Language/SQL/SimpleSQL/QueryExprComponents.hs view
@@ -0,0 +1,228 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++queryExprComponentTests :: TestItem+queryExprComponentTests = Group "queryExprComponentTests"+ [duplicates+ ,selectLists+ ,whereClause+ ,having+ ,orderBy+ ,offsetFetch+ ,combos+ ,withQueries+ ,values+ ,tables+ ]++++duplicates :: TestItem+duplicates = Group "duplicates"+ [q "select a from t" $ ms SQDefault+ ,q "select all a from t" $ ms All+ ,q "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"+ [q "select 1"+ $ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]}++ ,q "select a"+ $ toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]}++ ,q "select a,b"+ $ toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)+ ,(Iden [Name Nothing "b"],Nothing)]}++ ,q "select 1+2,3+4"+ $ toQueryExpr $ makeSelect {msSelectList =+ [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)+ ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]}++ ,q "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")]}++ ,q "select a a, b b"+ $ toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")+ ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]}++ ,q "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)]}+ ,q "select * from t"+ $ toQueryExpr $ makeSelect {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}++ ,q "select t.* from t"+ $ toQueryExpr $ makeSelect {msSelectList = [(QStar [Name Nothing "t"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}++ ,q "select t.*, a as b, u.* from t"+ $ toQueryExpr $ makeSelect+ {msSelectList =+ [(QStar [Name Nothing "t"],Nothing)+ ,(Iden [Name Nothing "a"], Just $ Name Nothing "b")+ ,(QStar [Name Nothing "u"],Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]}+ + ]++whereClause :: TestItem+whereClause = Group "whereClause"+ [q "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"+ [q "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"+ [q "select a from t order by a"+ $ ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault]++ ,q "select a from t order by a, b"+ $ ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault+ ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault]++ ,q "select a from t order by a asc"+ $ ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault]++ ,q "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]++ ,q "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"+ [-- ansi standard+ q "select a from t offset 5 rows fetch next 10 rows only"+ $ ms (Just $ NumLit "5") (Just $ NumLit "10")+ ,q "select a from t offset 5 rows;"+ $ ms (Just $ NumLit "5") Nothing+ ,q "select a from t fetch next 10 row only;"+ $ ms Nothing (Just $ NumLit "10")+ ,q "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+ --,q "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"+ [q "select a from t union select b from u"+ $ QueryExprSetOp mst Union SQDefault Respectively msu++ ,q "select a from t intersect select b from u"+ $ QueryExprSetOp mst Intersect SQDefault Respectively msu++ ,q "select a from t except all select b from u"+ $ QueryExprSetOp mst Except All Respectively msu++ ,q "select a from t union distinct corresponding \+ \select b from u"+ $ QueryExprSetOp mst Union Distinct Corresponding msu++ ,q "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"+ [q "with u as (select a from t) select a from u"+ $ With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2++ ,q "with u(b) as (select a from t) select a from u"+ $ With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2++ ,q "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++ ,q "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"+ [q "values (1,2),(3,4)"+ $ Values [[NumLit "1", NumLit "2"]+ ,[NumLit "3", NumLit "4"]]+ ]++tables :: TestItem+tables = Group "tables"+ [q "table tbl" $ Table [Name Nothing "tbl"]+ ]++q :: HasCallStack => Text -> QueryExpr -> TestItem+q src ast = testQueryExpr ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/QueryExprParens.hs view
@@ -0,0 +1,47 @@++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Language.SQL.SimpleSQL.QueryExprParens (queryExprParensTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)+import qualified Text.RawString.QQ as R++queryExprParensTests :: TestItem+queryExprParensTests = Group "query expr parens"+ [q "(select * from t)" $ QueryExprParens $ ms "t"+ ,q "select * from t except (select * from u except select * from v)"+ $ (ms "t") `sexcept` QueryExprParens (ms "u" `sexcept` ms "v")+ + ,q "(select * from t except select * from u) except select * from v"+ $ QueryExprParens (ms "t" `sexcept` ms "u") `sexcept` ms "v"++ ,q [R.r|+select * from t+union+with a as (select * from u)+select * from a+|]+ $ ms "t" `sunion` with [("a", ms "u")] (ms "a")++ ,q [R.r|+select * from t+union+(with a as (select * from u)+ select * from a)+|]+ $ ms "t" `sunion` QueryExprParens (with [("a", ms "u")] (ms "a"))+ ]+ where+ q :: HasCallStack => Text -> QueryExpr -> TestItem+ q src ast = testQueryExpr ansi2011 src ast+ ms t = toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing t]]}+ sexcept = so Except+ sunion = so Union+ so op a b = QueryExprSetOp a op SQDefault Respectively b+ with es s =+ With False (flip map es $ \(n,sn) -> (Alias (Name Nothing n) Nothing ,sn)) s
+ tests/Language/SQL/SimpleSQL/QueryExprs.hs view
@@ -0,0 +1,31 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++queryExprsTests :: TestItem+queryExprsTests = Group "query exprs"+ [q "select 1" [ms]+ ,q "select 1;" [ms]+ ,q "select 1;select 1" [ms,ms]+ ,q " select 1;select 1; " [ms,ms]+ ,q "SELECT CURRENT_TIMESTAMP;"+ [SelectStatement $ toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}]+ ,q "SELECT \"CURRENT_TIMESTAMP\";"+ [SelectStatement $ toQueryExpr $ makeSelect+ {msSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}]+ ]+ where+ ms = SelectStatement $ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]}+ q :: HasCallStack => Text -> [Statement] -> TestItem+ q src ast = testStatements ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs view
@@ -0,0 +1,304 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++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+-}++ s "grant all privileges on tbl1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1"] WithoutGrantOption+++ ,s "grant all privileges on tbl1 to role1,role2"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption++ ,s "grant all privileges on tbl1 to role1 with grant option"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1"] WithGrantOption++ ,s "grant all privileges on table tbl1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivTable [Name Nothing "tbl1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "grant all privileges on domain mydom to role1"+ $ GrantPrivilege [PrivAll]+ (PrivDomain [Name Nothing "mydom"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "grant all privileges on type t1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivType [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "grant all privileges on sequence s1 to role1"+ $ GrantPrivilege [PrivAll]+ (PrivSequence [Name Nothing "s1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "grant select on table t1 to role1"+ $ GrantPrivilege [PrivSelect []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "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++ ,s "grant delete on table t1 to role1"+ $ GrantPrivilege [PrivDelete]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "grant insert on table t1 to role1"+ $ GrantPrivilege [PrivInsert []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "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++ ,s "grant update on table t1 to role1"+ $ GrantPrivilege [PrivUpdate []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "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++ ,s "grant references on table t1 to role1"+ $ GrantPrivilege [PrivReferences []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "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++ ,s "grant usage on table t1 to role1"+ $ GrantPrivilege [PrivUsage]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "grant trigger on table t1 to role1"+ $ GrantPrivilege [PrivTrigger]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] WithoutGrantOption+++ ,s "grant execute on specific function f to role1"+ $ GrantPrivilege [PrivExecute]+ (PrivFunction [Name Nothing "f"])+ [Name Nothing "role1"] WithoutGrantOption++ ,s "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> ]+-}++ ,s "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>+-}++ ,s "grant role1 to public"+ $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption++ ,s "grant role1,role2 to role3,role4"+ $ GrantRole [Name Nothing "role1",Name Nothing "role2"]+ [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption++ ,s "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>+-}++ ,s "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+-}+++ ,s "revoke select on t1 from role1"+ $ RevokePrivilege NoGrantOptionFor [PrivSelect []]+ (PrivTable [Name Nothing "t1"])+ [Name Nothing "role1"] DefaultDropBehaviour++ ,s+ "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>+-}++ ,s "revoke role1 from role2"+ $ RevokeRole NoAdminOptionFor [Name Nothing "role1"]+ [Name Nothing "role2"] DefaultDropBehaviour++ ,s "revoke role1,role2 from role3,role4"+ $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]+ [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour+++ ,s "revoke admin option for role1 from role2 cascade"+ $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade++ ]++s :: HasCallStack => Text -> Statement -> TestItem+s src ast = testStatement ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/SQL2011Bits.hs view
@@ -0,0 +1,226 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++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!+-}++ s "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>+-}++ ,s "savepoint difficult_bit"+ $ Savepoint $ Name Nothing "difficult_bit"+++{-+17.6 <release savepoint statement>++<release savepoint statement> ::=+ RELEASE SAVEPOINT <savepoint specifier>+-}++ ,s "release savepoint difficult_bit"+ $ ReleaseSavepoint $ Name Nothing "difficult_bit"+++{-+17.7 <commit statement>++<commit statement> ::=+ COMMIT [ WORK ] [ AND [ NO ] CHAIN ]+-}++ ,s "commit" Commit++ ,s "commit work" Commit+++{-+17.8 <rollback statement>++<rollback statement> ::=+ ROLLBACK [ WORK ] [ AND [ NO ] CHAIN ] [ <savepoint clause> ]++<savepoint clause> ::=+ TO SAVEPOINT <savepoint specifier>+-}++ ,s "rollback" $ Rollback Nothing++ ,s "rollback work" $ Rollback Nothing++ ,s "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>+-}++ ]++s :: HasCallStack => Text -> Statement -> TestItem+s src ast = testStatement ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs view
@@ -0,0 +1,560 @@++-- Section 14 in Foundation+++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++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> ]+-}++ s "delete from t"+ $ Delete [Name Nothing "t"] Nothing Nothing++ ,s "delete from t as u"+ $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing++ ,s "delete from t where x = 5"+ $ Delete [Name Nothing "t"] Nothing+ (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5"))+++ ,s "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+-}++ ,s "truncate table t"+ $ Truncate [Name Nothing "t"] DefaultIdentityRestart++ ,s "truncate table t continue identity"+ $ Truncate [Name Nothing "t"] ContinueIdentity++ ,s "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>+-}++ ,s "insert into t select * from u"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "u"]]}++ ,s "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"]]}++ ,s "insert into t default values"+ $ Insert [Name Nothing "t"] Nothing DefaultInsertValues++ ,s "insert into t values(1,2)"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ Values [[NumLit "1", NumLit "2"]]++ ,s "insert into t values (1,2),(3,4)"+ $ Insert [Name Nothing "t"] Nothing+ $ InsertQuery $ Values [[NumLit "1", NumLit "2"]+ ,[NumLit "3", NumLit "4"]]++ ,s+ "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> ]+-}+++ ,s "update t set a=b"+ $ Update [Name Nothing "t"] Nothing+ [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing++ ,s "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+++ ,s "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")+++ ,s "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")++ ,s "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> }... ]+-}+++ ]++s :: HasCallStack => Text -> Statement -> TestItem+s src ast = testStatement ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/SQL2011Queries.hs view
@@ -0,0 +1,4508 @@++{-+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)+import Language.SQL.SimpleSQL.TestRunners++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"+ $+ [e "'a regular string literal'"+ $ StringLit "'" "'" "a regular string literal"+ ,e "'something' ' some more' 'and more'"+ $ StringLit "'" "'" "something some moreand more"+ ,e "'something' \n ' some more' \t 'and more'"+ $ StringLit "'" "'" "something some moreand more"+ ,e "'something' -- a comment\n ' some more' /*another comment*/ 'and more'"+ $ StringLit "'" "'" "something some moreand more"+ ,e "'a quote: '', stuff'"+ $ StringLit "'" "'" "a quote: '', stuff"+ ,e "''"+ $ 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.+-}++ ,e "_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"+ $+ [e "N'something'" $ StringLit "N'" "'" "something"+ ,e "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"+ $+ [e "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"+ $+ [--("B'101010'", CSStringLit "B" "101010")+ e "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"+ [e "11" $ NumLit "11"+ ,e "11.11" $ NumLit "11.11"++ ,e "11E23" $ NumLit "11E23"+ ,e "11E+23" $ NumLit "11E+23"+ ,e "11E-23" $ NumLit "11E-23"++ ,e "11.11E23" $ NumLit "11.11E23"+ ,e "11.11E+23" $ NumLit "11.11E+23"+ ,e "11.11E-23" $ NumLit "11.11E-23"++ ,e "+11E23" $ PrefixOp [Name Nothing "+"] $ NumLit "11E23"+ ,e "+11E+23" $ PrefixOp [Name Nothing "+"] $ NumLit "11E+23"+ ,e "+11E-23" $ PrefixOp [Name Nothing "+"] $ NumLit "11E-23"+ ,e "+11.11E23" $ PrefixOp [Name Nothing "+"] $ NumLit "11.11E23"+ ,e "+11.11E+23" $ PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23"+ ,e "+11.11E-23" $ PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23"++ ,e "-11E23" $ PrefixOp [Name Nothing "-"] $ NumLit "11E23"+ ,e "-11E+23" $ PrefixOp [Name Nothing "-"] $ NumLit "11E+23"+ ,e "-11E-23" $ PrefixOp [Name Nothing "-"] $ NumLit "11E-23"+ ,e "-11.11E23" $ PrefixOp [Name Nothing "-"] $ NumLit "11.11E23"+ ,e "-11.11E+23" $ PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23"+ ,e "-11.11E-23" $ PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23"++ ,e "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"+ [e "interval '1'" $ TypedLit (TypeName [Name Nothing "interval"]) "1"+ ,e "interval '1' day"+ $ IntervalLit Nothing "1" (Itf "day" Nothing) Nothing+ ,e "interval '1' day(3)"+ $ IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing+ ,e "interval + '1' day(3)"+ $ IntervalLit (Just Plus) "1" (Itf "day" $ Just (3,Nothing)) Nothing+ ,e "interval - '1' second(2,2)"+ $ IntervalLit (Just Minus) "1" (Itf "second" $ Just (2,Just 2)) Nothing+ ,e "interval '1' year to month"+ $ IntervalLit Nothing "1" (Itf "year" Nothing)+ (Just $ Itf "month" Nothing)+ ,e "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"+ [e "true" $ Iden [Name Nothing "true"]+ ,e "false" $ Iden [Name Nothing "false"]+ ,e "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"+ [e "test" $ Iden [Name Nothing "test"]+ ,e "_test" $ Iden [Name Nothing "_test"]+ ,e "t1" $ Iden [Name Nothing "t1"]+ ,e "a.b" $ Iden [Name Nothing "a", Name Nothing "b"]+ ,e "a.b.c" $ Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"]+ ,e "\"quoted iden\"" $ Iden [Name (Just ("\"", "\"")) "quoted iden"]+ ,e "\"quoted \"\" iden\"" $ Iden [Name (Just ("\"", "\"")) "quoted \"\" iden"]+ ,e "U&\"quoted iden\"" $ Iden [Name (Just ("U&\"", "\"")) "quoted iden"]+ ,e "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"+ [e "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"+ [e "(3)" $ Parens (NumLit "3")+ ,e "((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 mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"+ ,"CURRENT_PATH"+ ,"CURRENT_ROLE"+ ,"CURRENT_USER"+ ,"SESSION_USER"+ ,"SYSTEM_USER"+ ,"USER"+ ,"VALUE"]+ where+ mkIden nm = e 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"+ [e ":hostparam" $ HostParameter ":hostparam" Nothing+ ,e ":hostparam indicator :another_host_param"+ $ HostParameter ":hostparam" $ Just ":another_host_param"+ ,e "?" $ Parameter+ ,e ":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"+ [e "null" $ Iden [Name Nothing "null"]+ ,e "array[]" $ Array (Iden [Name Nothing "array"]) []+ ,e "multiset[]" $ MultisetCtor []+ ,e "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"+ [e "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"+ [e "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"+ $+ [q "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"+ [e "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"+ [e "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"+ [e "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"+ [e "something[3]"+ $ Array (Iden [Name Nothing "something"]) [NumLit "3"]+ ,e "(something(a))[x]"+ $ Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))+ [Iden [Name Nothing "x"]]+ ,e "(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"+ [e "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"+ [e "a + b" $ binOp "+"+ ,e "a - b" $ binOp "-"+ ,e "a * b" $ binOp "*"+ ,e "a / b" $ binOp "/"+ ,e "+a" $ prefOp "+"+ ,e "-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"+ [e "a or b" $ BinOp a [Name Nothing "or"] b+ ,e "a and b" $ BinOp a [Name Nothing "and"] b+ ,e "not a" $ PrefixOp [Name Nothing "not"] a+ ,e "a is true" $ postfixOp "is true"+ ,e "a is false" $ postfixOp "is false"+ ,e "a is unknown" $ postfixOp "is unknown"+ ,e "a is not true" $ postfixOp "is not true"+ ,e "a is not false" $ postfixOp "is not false"+ ,e "a is not unknown" $ postfixOp "is not unknown"+ ,e "(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"+ [e "array[1,2,3]"+ $ Array (Iden [Name Nothing "array"])+ [NumLit "1", NumLit "2", NumLit "3"]+ ,e "array[a,b,c]"+ $ Array (Iden [Name Nothing "array"])+ [Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]]+ ,e "array(select * from t)"+ $ ArrayCtor (toQueryExpr $ makeSelect+ {msSelectList = [(Star,Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]})+ ,e "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 =+ [(QStar [Name Nothing "a"]+ ,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"]]}+++q :: HasCallStack => Text -> QueryExpr -> TestItem+q src ast = testQueryExpr ansi2011 src ast++e :: HasCallStack => Text -> ScalarExpr -> TestItem+e src ast = testScalarExpr ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/SQL2011Schema.hs view
@@ -0,0 +1,2239 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++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>... ]+-}++ s "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+-}+++ ,s "drop schema my_schema"+ $ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour+ ,s "drop schema my_schema cascade"+ $ DropSchema [Name Nothing "my_schema"] Cascade+ ,s "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 ]+-}++ ,s "create table t (a int, b int);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []]+ False+++{-+<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+-}+++ ,s+ "create table t (a int not null);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing ColNotNullConstraint]]+ False++ ,s+ "create table t (a int constraint a_not_null not null);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]]+ False++ ,s+ "create table t (a int unique);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing ColUniqueConstraint]]+ False++ ,s+ "create table t (a int primary key);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing (ColPrimaryKeyConstraint False)]]+ False++ ,testStatement ansi2011{ diAutoincrement = True }+ "create table t (a int primary key autoincrement);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing (ColPrimaryKeyConstraint True)]]+ False++{-+references t(a,b)+ [ Full |partial| simepl]+ [perm: on update [cascade | set null | set default | restrict | no action]+ on delete ""+-}++ ,s+ "create table t (a int references u);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u(a));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u match full);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing MatchFull+ DefaultReferentialAction DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u match partial);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing MatchPartial+ DefaultReferentialAction DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u match simple);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing MatchSimple+ DefaultReferentialAction DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u on update cascade );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefCascade DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u on update set null );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefSetNull DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u on update set default );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefSetDefault DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u on update no action );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefNoAction DefaultReferentialAction]]+ False++ ,s+ "create table t (a int references u on delete cascade );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ DefaultReferentialAction RefCascade]]+ False+++ ,s+ "create table t (a int references u on update cascade on delete restrict );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefCascade RefRestrict]]+ False++ ,s+ "create table t (a int references u on delete restrict on update cascade );"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing $ ColReferencesConstraint+ [Name Nothing "u"] Nothing DefaultReferenceMatch+ RefCascade RefRestrict]]+ False++{-+TODO: try combinations and permutations of column constraints and+options+-}+++ ,s+ "create table t (a int check (a>5));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ (ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]]+ False++++++{-+<identity column specification> ::=+ GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY+ [ <left paren> <common sequence generator options> <right paren> ]+-}++ ,s "create table t (a int generated always as identity);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ IdentityColumnSpec GeneratedAlways []]]+ False++ ,s "create table t (a int generated by default as identity);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ IdentityColumnSpec GeneratedByDefault []]]+ False+++ ,s+ "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") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ IdentityColumnSpec GeneratedAlways+ [SGOStartWith 5+ ,SGOIncrementBy 5+ ,SGOMaxValue 500+ ,SGOMinValue 5+ ,SGOCycle]]]+ False++ ,s+ "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") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ IdentityColumnSpec GeneratedAlways+ [SGOStartWith (-4)+ ,SGONoMaxValue+ ,SGONoMinValue+ ,SGONoCycle]]]+ False++{-+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>+-}++ ,s+ "create table t (a int, \n\+ \ a2 int generated always as (a * 2));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "a2") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ GenerationClause (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))]]+ False++++{-+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>+-}+++ ,s "create table t (a int default 0);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ DefaultClause $ NumLit "0"]]+ False++++{-+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>+-}++ ,s+ "create table t (a int, unique (a));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"]+ ]+ False++ ,s+ "create table t (a int, constraint a_unique unique (a));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef (Just [Name Nothing "a_unique"]) $+ TableUniqueConstraint [Name Nothing "a"]+ ]+ False++-- todo: test permutations of column defs and table constraints++ ,s+ "create table t (a int, b int, unique (a,b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef Nothing $+ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]+ ]+ False++ ,s+ "create table t (a int, b int, primary key (a,b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef Nothing $+ TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"]+ ]+ False+++{-+<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>+-}+++ ,s+ "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") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef Nothing $+ TableReferencesConstraint+ [Name Nothing "a", Name Nothing "b"]+ [Name Nothing "u"]+ (Just [Name Nothing "c", Name Nothing "d"])+ MatchFull RefCascade RefRestrict+ ]+ False++ ,s+ "create table t (a int,\n\+ \ constraint tfku1 foreign key (a) references u);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef (Just [Name Nothing "tfku1"]) $+ TableReferencesConstraint+ [Name Nothing "a"]+ [Name Nothing "u"]+ Nothing DefaultReferenceMatch+ DefaultReferentialAction DefaultReferentialAction+ ]+ False++ ,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") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []+ ,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+ ]+ False+ ,testStatement ansi2011{ diWithoutRowidTables = True }+ "create table t (a int) without rowid;"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []]+ True+ ,testStatement ansi2011{ diOptionalColumnTypes = True }+ "create table t (a,b);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") Nothing []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") Nothing []+ ]+ False+ ,testStatement ansi2011{ diDefaultClausesAsConstraints = True }+ "create table t (a int default 1 default 2);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing+ $ ColDefaultClause+ $ DefaultClause $ NumLit "1"+ ,ColConstraintDef Nothing+ $ ColDefaultClause+ $ DefaultClause $ NumLit "2"]]+ False+ ,testStatement ansi2011{ diDefaultClausesAsConstraints = True }+ "create table t (a int not null default 2);"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"]))+ [ColConstraintDef Nothing ColNotNullConstraint+ ,ColConstraintDef Nothing+ $ ColDefaultClause+ $ DefaultClause $ NumLit "2"]]+ False+++{-+<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>+-}++ ,s+ "create table t (a int, b int, \n\+ \ check (a > b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef Nothing $+ TableCheckConstraint+ (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))+ ]+ False+++ ,s+ "create table t (a int, b int, \n\+ \ constraint agtb check (a > b));"+ $ CreateTable [Name Nothing "t"]+ [TableColumnDef $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []+ ,TableColumnDef $ ColumnDef (Name Nothing "b") (Just (TypeName [Name Nothing "int"])) []+ ,TableConstraintDef (Just [Name Nothing "agtb"]) $+ TableCheckConstraint+ (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))+ ]+ False+++{-+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)+-}++ ,s+ "alter table t add column a int"+ $ AlterTable [Name Nothing "t"] $ AddColumnDef+ $ ColumnDef (Name Nothing "a") (Just (TypeName [Name Nothing "int"])) []++{-+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>+-}+++ ,s+ "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+-}++ ,s+ "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+-}++ ,s+ "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+-}++ ,s+ "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>+-}++ ,s+ "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>+-}++ ,s+ "alter table t drop column c"+ $ AlterTable [Name Nothing "t"] $+ DropColumn (Name Nothing "c") DefaultDropBehaviour++ ,s+ "alter table t drop c cascade"+ $ AlterTable [Name Nothing "t"] $+ DropColumn (Name Nothing "c") Cascade++ ,s+ "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>+-}++ ,s+ "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"]++ ,s+ "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>+-}++ ,s+ "alter table t drop constraint c"+ $ AlterTable [Name Nothing "t"] $+ DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour++ ,s+ "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>+-}++ ,s+ "drop table t"+ $ DropTable [Name Nothing "t"] DefaultDropBehaviour++ ,s+ "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>+-}++ ,s+ "create view v as select * from t"+ $ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect+ {msSelectList = [(Star, Nothing)]+ ,msFrom = [TRSimple [Name Nothing "t"]]+ }) Nothing+++ ,s+ "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++ ,s+ "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+++ ,s+ "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)++ ,s+ "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)++ ,s+ "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>+-}+++ ,s+ "drop view v"+ $ DropView [Name Nothing "v"] DefaultDropBehaviour++ ,s+ "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> ]+-}++ ,s+ "create domain my_int int"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ Nothing []++ ,s+ "create domain my_int as int"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ Nothing []++ ,s+ "create domain my_int int default 0"+ $ CreateDomain [Name Nothing "my_int"]+ (TypeName [Name Nothing "int"])+ (Just (NumLit "0")) []++ ,s+ "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"))]++ ,s+ "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>+-}++ ,s+ "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+-}++ ,s+ "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>+-}++ ,s+ "alter domain my_int add check (value > 6)"+ $ AlterDomain [Name Nothing "my_int"]+ $ ADAddConstraint Nothing+ $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6")++ ,s+ "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>+-}++ ,s+ "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>+-}++ ,s+ "drop domain my_int"+ $ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour++ ,s+ "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> ]+-}++ ,s+ "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> ]+-}++ ,s+ "drop assertion t1_not_empty;"+ $ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour++ ,s+ "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+-}++ ,s+ "create sequence seq"+ $ CreateSequence [Name Nothing "seq"] []++ ,s+ "create sequence seq as bigint"+ $ CreateSequence [Name Nothing "seq"]+ [SGODataType $ TypeName [Name Nothing "bigint"]]++ ,s+ "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>+-}++ ,s+ "alter sequence seq restart"+ $ AlterSequence [Name Nothing "seq"]+ [SGORestart Nothing]++ ,s+ "alter sequence seq restart with 5"+ $ AlterSequence [Name Nothing "seq"]+ [SGORestart $ Just 5]++ ,s+ "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>+-}++ ,s+ "drop sequence seq"+ $ DropSequence [Name Nothing "seq"] DefaultDropBehaviour++ ,s+ "drop sequence seq restrict"+ $ DropSequence [Name Nothing "seq"] Restrict+++ ]++s :: HasCallStack => Text -> Statement -> TestItem+s src ast = testStatement ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/ScalarExprs.hs view
@@ -0,0 +1,436 @@++-- Tests for parsing scalar expressions++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where++import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestRunners++import Data.Text (Text)++scalarExprTests :: TestItem+scalarExprTests = Group "scalarExprTests"+ [literals+ ,identifiers+ ,star+ ,parameter+ ,dots+ ,app+ ,caseexp+ ,convertfun + ,operators+ ,parens+ ,subqueries+ ,aggregates+ ,windowFunctions+ ,functionsWithReservedNames+ ]++t :: HasCallStack => Text -> ScalarExpr -> TestItem+t src ast = testScalarExpr ansi2011 src ast++td :: HasCallStack => Dialect -> Text -> ScalarExpr -> TestItem+td d src ast = testScalarExpr d src ast++++literals :: TestItem+literals = Group "literals"+ [t "3" $ NumLit "3"+ ,t "3." $ NumLit "3."+ ,t "3.3" $ NumLit "3.3"+ ,t ".3" $ NumLit ".3"+ ,t "3.e3" $ NumLit "3.e3"+ ,t "3.3e3" $ NumLit "3.3e3"+ ,t ".3e3" $ NumLit ".3e3"+ ,t "3e3" $ NumLit "3e3"+ ,t "3e+3" $ NumLit "3e+3"+ ,t "3e-3" $ NumLit "3e-3"+ ,t "'string'" $ StringLit "'" "'" "string"+ ,t "'string with a '' quote'" $ StringLit "'" "'" "string with a '' quote"+ ,t "'1'" $ StringLit "'" "'" "1"+ ,t "interval '3' day"+ $ IntervalLit Nothing "3" (Itf "day" Nothing) Nothing+ ,t "interval '3' day (3)"+ $ IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing+ ,t "interval '3 weeks'" $ TypedLit (TypeName [Name Nothing "interval"]) "3 weeks"+ ]+ +identifiers :: TestItem+identifiers = Group "identifiers"+ [t "iden1" $ Iden [Name Nothing "iden1"]+ --,("t.a", Iden2 "t" "a")+ ,t "\"quoted identifier\"" $ Iden [Name (Just ("\"","\"")) "quoted identifier"]+ ,t "\"from\"" $ Iden [Name (Just ("\"","\"")) "from"]+ ]++star :: TestItem+star = Group "star"+ [t "count(*)" $ App [Name Nothing "count"] [Star]+ ,t "ROW(t.*,42)" $ App [Name Nothing "ROW"] [QStar [Name Nothing "t"], NumLit "42"]+ ]++parameter :: TestItem+parameter = Group "parameter"+ [td ansi2011 "?" Parameter+ ,td postgres "$13" $ PositionalArg 13]++dots :: TestItem+dots = Group "dot"+ [t "t.a" $ Iden [Name Nothing "t",Name Nothing "a"]+ ,t "a.b.c" $ Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"]+ ,t "ROW(t.*,42)" $ App [Name Nothing "ROW"] [QStar [Name Nothing "t"], NumLit "42"]+ ]++app :: TestItem+app = Group "app"+ [t "f()" $ App [Name Nothing "f"] []+ ,t "f(a)" $ App [Name Nothing "f"] [Iden [Name Nothing "a"]]+ ,t "f(a,b)" $ App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]+ ]++caseexp :: TestItem+caseexp = Group "caseexp"+ [t "case a when 1 then 2 end"+ $ Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]+ ,NumLit "2")] Nothing++ ,t "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++ ,t "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")++ ,t "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")++ ,t "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"+ [td sqlserver "CONVERT(varchar, 25.65)"+ $ Convert (TypeName [Name Nothing "varchar"]) (NumLit "25.65") Nothing+ ,td sqlserver "CONVERT(datetime, '2017-08-25')"+ $ Convert (TypeName [Name Nothing "datetime"]) (StringLit "'" "'" "2017-08-25") Nothing+ ,td sqlserver "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"+ [t "a + b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])+ -- sanity check fixities+ -- todo: add more fixity checking++ ,t "a + b * c"+ $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]+ (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))++ ,t "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"+ [t "not a" $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"]+ ,t "not not a" $ PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"]+ ,t "+a" $ PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"]+ ,t "-a" $ PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"]+ ]+++casts :: TestItem+casts = Group "operators"+ [t "cast('1' as int)"+ $ Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"]++ ,t "int '3'"+ $ TypedLit (TypeName [Name Nothing "int"]) "3"++ ,t "cast('1' as double precision)"+ $ Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"]++ ,t "cast('1' as float(8))"+ $ Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8++ ,t "cast('1' as decimal(15,2))"+ $ Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2++ ,t "double precision '3'"+ $ TypedLit (TypeName [Name Nothing "double precision"]) "3"+ ]++subqueries :: TestItem+subqueries = Group "unaryOperators"+ [t "exists (select a from t)" $ SubQueryExpr SqExists ms+ ,t "(select a from t)" $ SubQueryExpr SqSq ms++ ,t "a in (select a from t)"+ $ In True (Iden [Name Nothing "a"]) (InQueryExpr ms)++ ,t "a not in (select a from t)"+ $ In False (Iden [Name Nothing "a"]) (InQueryExpr ms)++ ,t "a > all (select a from t)"+ $ QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms++ ,t "a = some (select a from t)"+ $ QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms++ ,t "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"+ [t "a in (1,2,3)"+ $ In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"]++ ,t "a is null" $ PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"])+ ,t "a is not null" $ PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"])+ ,t "a is true" $ PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"])+ ,t "a is not true" $ PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"])+ ,t "a is false" $ PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"])+ ,t "a is not false" $ PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"])+ ,t "a is unknown" $ PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"])+ ,t "a is not unknown" $ PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"])+ ,t "a is distinct from b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"])++ ,t "a is not distinct from b"+ $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"])++ ,t "a like b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"])+ ,t "a not like b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"])+ ,t "a is similar to b"$ BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"])++ ,t "a is not similar to b"+ $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"])++ ,t "a overlaps b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"])++-- special operators++ ,t "a between b and c" $ SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]+ ,Iden [Name Nothing "b"]+ ,Iden [Name Nothing "c"]]++ ,t "a not between b and c" $ SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]+ ,Iden [Name Nothing "b"]+ ,Iden [Name Nothing "c"]]+ ,t "(1,2)"+ $ SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"]+++-- keyword special operators++ ,t "extract(day from t)"+ $ SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])]++ ,t "substring(x from 1 for 2)"+ $ SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")+ ,("for", NumLit "2")]++ ,t "substring(x from 1)"+ $ SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")]++ ,t "substring(x for 2)"+ $ SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")]++ ,t "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++ ,t "POSITION( string1 IN string2 )"+ $ SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])]++ ,t "CONVERT(char_value USING conversion_char_name)"+ $ SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])+ [("using", Iden [Name Nothing "conversion_char_name"])]++ ,t "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])+-}++ ,t "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"])]++ ,t "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] )+-}++++ ,t "trim(from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("both", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])]++ ,t "trim(leading from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("leading", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])]++ ,t "trim(trailing from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("trailing", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])]++ ,t "trim(both from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("both", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])]+++ ,t "trim(leading 'x' from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("leading", StringLit "'" "'" "x")+ ,("from", Iden [Name Nothing "target_string"])]++ ,t "trim(trailing 'y' from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("trailing", StringLit "'" "'" "y")+ ,("from", Iden [Name Nothing "target_string"])]++ ,t "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"])]++ ,t "trim(leading from target_string)"+ $ SpecialOpK [Name Nothing "trim"] Nothing+ [("leading", StringLit "'" "'" " ")+ ,("from", Iden [Name Nothing "target_string"])]++ ]++aggregates :: TestItem+aggregates = Group "aggregates"+ [t "count(*)" $ App [Name Nothing "count"] [Star]++ ,t "sum(a order by a)"+ $ AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]+ [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing++ ,t "sum(all a)"+ $ AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing++ ,t "count(distinct a)"+ $ AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing+ ]++windowFunctions :: TestItem+windowFunctions = Group "windowFunctions"+ [t "max(a) over ()" $ WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing+ ,t "count(*) over ()" $ WindowApp [Name Nothing "count"] [Star] [] [] Nothing++ ,t "max(a) over (partition by b)"+ $ WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing++ ,t "max(a) over (partition by b,c)"+ $ WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing++ ,t "sum(a) over (order by b)"+ $ WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []+ [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing++ ,t "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++ ,t "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++ ,t "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++ ,t "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")++ ,t "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++ ,t "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")++ ,t "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++ ,t "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"+ [t "(a)" $ Parens (Iden [Name Nothing "a"])+ ,t "(a + b)" $ Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))+ ]++functionsWithReservedNames :: TestItem+functionsWithReservedNames = Group "functionsWithReservedNames" $ map f+ ["abs"+ ,"char_length"+ ]+ where+ f fn = t (fn <> "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]
+ tests/Language/SQL/SimpleSQL/TableRefs.hs view
@@ -0,0 +1,111 @@++{-+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+import Language.SQL.SimpleSQL.TestRunners+import Data.Text (Text)++tableRefTests :: TestItem+tableRefTests = Group "tableRefTests"+ [q "select a from t"+ $ ms [TRSimple [Name Nothing "t"]]++ ,q "select a from f(a)"+ $ ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]]++ ,q "select a from t,u"+ $ ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]++ ,q "select a from s.t"+ $ ms [TRSimple [Name Nothing "s", Name Nothing "t"]]++-- these lateral queries make no sense but the syntax is valid++ ,q "select a from lateral a"+ $ ms [TRLateral $ TRSimple [Name Nothing "a"]]++ ,q "select a from lateral a,b"+ $ ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]]++ ,q "select a from a, lateral b"+ $ ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]]++ ,q "select a from a natural join lateral b"+ $ ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner+ (TRLateral $ TRSimple [Name Nothing "b"])+ Nothing]++ ,q "select a from lateral a natural join lateral b"+ $ ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner+ (TRLateral $ TRSimple [Name Nothing "b"])+ Nothing]+++ ,q "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"])]++ ,q "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"])]++ ,q "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"])]++ ,q "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"])]++ ,q "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"])]++ ,q "select a from t cross join u"+ $ ms [TRJoin (TRSimple [Name Nothing "t"]) False+ JCross (TRSimple [Name Nothing "u"]) Nothing]++ ,q "select a from t natural inner join u"+ $ ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"])+ Nothing]++ ,q "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"])]++ ,q "select a from (select a from t)"+ $ ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]]++ ,q "select a from t as u"+ $ ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)]++ ,q "select a from t u"+ $ ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)]++ ,q "select a from t u(b)"+ $ ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])]++ ,q "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++ ,q "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}+ q :: HasCallStack => Text -> QueryExpr -> TestItem+ q src ast = testQueryExpr ansi2011 src ast
+ tests/Language/SQL/SimpleSQL/TestRunners.hs view
@@ -0,0 +1,92 @@++{-# LANGUAGE OverloadedStrings #-}+module Language.SQL.SimpleSQL.TestRunners+ (testLex+ ,lexFails+ ,testScalarExpr+ ,testQueryExpr+ ,testStatement+ ,testStatements+ ,testParseQueryExpr+ ,testParseQueryExprFails+ ,testParseScalarExprFails+ ,HasCallStack+ ) where++import Language.SQL.SimpleSQL.Syntax+import Language.SQL.SimpleSQL.TestTypes+import Language.SQL.SimpleSQL.Pretty+import Language.SQL.SimpleSQL.Parse+import qualified Language.SQL.SimpleSQL.Lex as Lex++import Data.Text (Text)+import qualified Data.Text as T++import Language.SQL.SimpleSQL.Expectations+ (shouldParseL+ ,shouldFail+ ,shouldParseA+ ,shouldSucceed+ )+ +import Test.Hspec+ (it+ ,HasCallStack+ )++testLex :: HasCallStack => Dialect -> Text -> [Lex.Token] -> TestItem+testLex d input a =+ LexTest d input a $ do+ it (T.unpack input) $ Lex.lexSQL d False "" Nothing input `shouldParseL` a+ it (T.unpack $ "pp: " <> input) $ Lex.lexSQL d False "" Nothing (Lex.prettyTokens d a) `shouldParseL` a++lexFails :: HasCallStack => Dialect -> Text -> TestItem+lexFails d input =+ LexFails d input $ + it (T.unpack input) $ shouldFail $ Lex.lexSQL d False "" Nothing input++testScalarExpr :: HasCallStack => Dialect -> Text -> ScalarExpr -> TestItem+testScalarExpr d input a =+ TestScalarExpr d input a $ do+ it (T.unpack input) $ parseScalarExpr d "" Nothing input `shouldParseA` a+ it (T.unpack $ "pp: " <> input) $ parseScalarExpr d "" Nothing (prettyScalarExpr d a) `shouldParseA` a++testQueryExpr :: HasCallStack => Dialect -> Text -> QueryExpr -> TestItem+testQueryExpr d input a =+ TestQueryExpr d input a $ do+ it (T.unpack input) $ parseQueryExpr d "" Nothing input `shouldParseA` a+ it (T.unpack $ "pp: " <> input) $ parseQueryExpr d "" Nothing (prettyQueryExpr d a) `shouldParseA` a++testParseQueryExpr :: HasCallStack => Dialect -> Text -> TestItem+testParseQueryExpr d input =+ let a = parseQueryExpr d "" Nothing input+ in ParseQueryExpr d input $ do+ it (T.unpack input) $ shouldSucceed (T.unpack . prettyError) a+ case a of+ Left _ -> pure ()+ Right a' ->+ it (T.unpack $ "pp: " <> input) $+ parseQueryExpr d "" Nothing (prettyQueryExpr d a') `shouldParseA` a'++testParseQueryExprFails :: HasCallStack => Dialect -> Text -> TestItem+testParseQueryExprFails d input =+ ParseQueryExprFails d input $ + it (T.unpack input) $ shouldFail $ parseQueryExpr d "" Nothing input++testParseScalarExprFails :: HasCallStack => Dialect -> Text -> TestItem+testParseScalarExprFails d input =+ ParseScalarExprFails d input $ + it (T.unpack input) $ shouldFail $ parseScalarExpr d "" Nothing input++testStatement :: HasCallStack => Dialect -> Text -> Statement -> TestItem+testStatement d input a =+ TestStatement d input a $ do+ it (T.unpack input) $ parseStatement d "" Nothing input `shouldParseA` a+ it (T.unpack $ "pp: " <> input) $ parseStatement d "" Nothing (prettyStatement d a) `shouldParseA` a++testStatements :: HasCallStack => Dialect -> Text -> [Statement] -> TestItem+testStatements d input a =+ TestStatements d input a $ do+ it (T.unpack input) $ parseStatements d "" Nothing input `shouldParseA` a+ it (T.unpack $ "pp: " <> input) $ parseStatements d "" Nothing (prettyStatements d a) `shouldParseA` a+
+ tests/Language/SQL/SimpleSQL/TestTypes.hs view
@@ -0,0 +1,56 @@++{-+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 Test.Hspec (SpecWith)+++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.++The test items are designed to allow code to grab all the examples+in easily usable data types, but since hspec has this neat feature+where it will give a source location for a test failure, each testitem+apart from group already has the SpecWith attached to run that test,+that way we can attach the source location to each test item+-}++data TestItem = Group Text [TestItem]+ | TestScalarExpr Dialect Text ScalarExpr (SpecWith ())+ | TestQueryExpr Dialect Text QueryExpr (SpecWith ())+ | TestStatement Dialect Text Statement (SpecWith ())+ | TestStatements Dialect Text [Statement] (SpecWith ())++{-+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 (SpecWith ())++-- check that the string given fails to parse++ | ParseQueryExprFails Dialect Text (SpecWith ())+ | ParseScalarExprFails Dialect Text (SpecWith ())+ | LexTest Dialect Text [Token] (SpecWith ())+ | LexFails Dialect Text (SpecWith ())+ | GeneralParseFailTest Text Text (SpecWith ())+ | GoldenErrorTest Text [(Text,Text,Text)] (SpecWith ())+
+ tests/Language/SQL/SimpleSQL/Tests.hs view
@@ -0,0 +1,98 @@++{-+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 Test.Hspec+ (SpecWith+ ,describe+ ,parallel+ )++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.QueryExprParens+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 Language.SQL.SimpleSQL.ErrorMessages++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+ ,queryExprParensTests+ ,tableRefTests+ ,groupByTests+ ,fullQueriesTests+ ,postgresTests+ ,tpchTests+ ,sql2011QueryTests+ ,sql2011DataManipulationTests+ ,sql2011SchemaTests+ ,sql2011AccessControlTests+ ,sql2011BitsTests+ ,mySQLTests+ ,oracleTests+ ,customDialectTests+ ,emptyStatementTests+ ,createIndexTests+ ,errorMessageTests+ ]++tests :: SpecWith ()+tests = parallel $ itemToTest testData++itemToTest :: TestItem -> SpecWith ()+itemToTest (Group nm ts) =+ describe (T.unpack nm) $ mapM_ itemToTest ts+itemToTest (TestScalarExpr _ _ _ t) = t+itemToTest (TestQueryExpr _ _ _ t) = t+itemToTest (TestStatement _ _ _ t) = t+itemToTest (TestStatements _ _ _ t) = t+itemToTest (ParseQueryExpr _ _ t) = t+itemToTest (ParseQueryExprFails _ _ t) = t+itemToTest (ParseScalarExprFails _ _ t) = t+itemToTest (LexTest _ _ _ t) = t+itemToTest (LexFails _ _ t) = t+itemToTest (GeneralParseFailTest _ _ t) = t+itemToTest (GoldenErrorTest _ _ t) = t
+ tests/Language/SQL/SimpleSQL/Tpch.hs view
@@ -0,0 +1,690 @@++{-+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)+import Language.SQL.SimpleSQL.TestRunners++tpchTests :: TestItem+tpchTests = Group "parse tpch" tpchQueries++tpchQueries :: [TestItem]+tpchQueries =+ [q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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"+ ,q "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\+ \ )"+ ,q "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"+ ,q "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\+ \ )"+ ,q "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"+ ,q "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"+ ,q "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"+ ]+ where+ q :: HasCallStack => Text -> Text -> TestItem+ q _ src = testParseQueryExpr ansi2011 src
+ tests/RunTests.hs view
@@ -0,0 +1,9 @@+++import Test.Hspec (hspec)+++import Language.SQL.SimpleSQL.Tests++main :: IO ()+main = hspec tests
− 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 SQL2011))-> [("select count(*) from t"-> ,makeSelect-> {qeSelectList = [(App [Name "count"] [Star], Nothing)]-> ,qeFrom = [TRSimple [Name "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 "a"], Nothing)-> ,(App [Name "sum"]-> [BinOp (Iden [Name "c"])-> [Name "+"] (Iden [Name "d"])]-> ,Just $ Name "s")]-> ,qeFrom = [TRSimple [Name "t"], TRSimple [Name "u"]]-> ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5")-> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]]-> ,qeHaving = Just $ BinOp (App [Name "count"] [NumLit "1"])-> [Name ">"] (NumLit "5")-> ,qeOrderBy = [SortSpec (Iden [Name "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 SQL2011))-> [("select a,sum(b) from t group by a"-> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)-> ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]]-> })--> ,("select a,b,sum(c) from t group by a,b"-> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)-> ,(Iden [Name "b"],Nothing)-> ,(App [Name "sum"] [Iden [Name "c"]],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]-> ,SimpleGroup $ Iden [Name "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 SQL2011))-> [("select * from t group by ()", ms [GroupingParens []])-> ,("select * from t group by grouping sets ((), (a))"-> ,ms [GroupingSets [GroupingParens []-> ,GroupingParens [SimpleGroup $ Iden [Name "a"]]]])-> ,("select * from t group by cube(a,b)"-> ,ms [Cube [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]])-> ,("select * from t group by rollup(a,b)"-> ,ms [Rollup [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]])-> ]-> where-> ms g = makeSelect {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeGroupBy = g}--> randomGroupBy :: TestItem-> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr SQL2011)-> ["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/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 (TestValueExpr MySQL))-> [("`test`", Iden [DQName "`" "`" "test"])-> ]-> ++ [ParseValueExprFails SQL2011 "`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 SQL2011 "select * from t limit 5"]-> )-> where-> sel = makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> }
− 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 SQL2011)--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 SQL2011))-> [("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 "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]}--> selectLists :: TestItem-> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr SQL2011))-> [("select 1",-> makeSelect {qeSelectList = [(NumLit "1",Nothing)]})--> ,("select a"-> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]})--> ,("select a,b"-> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)-> ,(Iden [Name "b"],Nothing)]})--> ,("select 1+2,3+4"-> ,makeSelect {qeSelectList =-> [(BinOp (NumLit "1") [Name "+"] (NumLit "2"),Nothing)-> ,(BinOp (NumLit "3") [Name "+"] (NumLit "4"),Nothing)]})--> ,("select a as a, /*comment*/ b as b"-> ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a")-> ,(Iden [Name "b"], Just $ Name "b")]})--> ,("select a a, b b"-> ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a")-> ,(Iden [Name "b"], Just $ Name "b")]})--> ,("select a + b * c"-> ,makeSelect {qeSelectList =-> [(BinOp (Iden [Name "a"]) [Name "+"]-> (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"]))-> ,Nothing)]})--> ]--> whereClause :: TestItem-> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr SQL2011))-> [("select a from t where a = 5"-> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name "="] (NumLit "5")})-> ]--> having :: TestItem-> having = Group "having" $ map (uncurry (TestQueryExpr SQL2011))-> [("select a,sum(b) from t group by a having sum(b) > 5"-> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)-> ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]]-> ,qeHaving = Just $ BinOp (App [Name "sum"] [Iden [Name "b"]])-> [Name ">"] (NumLit "5")-> })-> ]--> orderBy :: TestItem-> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr SQL2011))-> [("select a from t order by a"-> ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault])--> ,("select a from t order by a, b"-> ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault-> ,SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault])--> ,("select a from t order by a asc"-> ,ms [SortSpec (Iden [Name "a"]) Asc NullsOrderDefault])--> ,("select a from t order by a desc, b desc"-> ,ms [SortSpec (Iden [Name "a"]) Desc NullsOrderDefault-> ,SortSpec (Iden [Name "b"]) Desc NullsOrderDefault])--> ,("select a from t order by a desc nulls first, b desc nulls last"-> ,ms [SortSpec (Iden [Name "a"]) Desc NullsFirst-> ,SortSpec (Iden [Name "b"]) Desc NullsLast])--> ]-> where-> ms o = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeOrderBy = o}--> offsetFetch :: TestItem-> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr SQL2011))-> [-- 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 "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeOffset = o-> ,qeFetchFirst = l}--> combos :: TestItem-> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))-> [("select a from t union select b from u"-> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)--> ,("select a from t intersect select b from u"-> ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2)--> ,("select a from t except all select b from u"-> ,CombineQueryExpr ms1 Except All Respectively ms2)--> ,("select a from t union distinct corresponding \-> \select b from u"-> ,CombineQueryExpr 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)-> ,CombineQueryExpr ms1 Union SQDefault Respectively-> (CombineQueryExpr ms1 Union SQDefault Respectively ms1))-> ]-> where-> ms1 = makeSelect-> {qeSelectList = [(Iden [Name "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]}-> ms2 = makeSelect-> {qeSelectList = [(Iden [Name "b"],Nothing)]-> ,qeFrom = [TRSimple [Name "u"]]}---> withQueries :: TestItem-> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr SQL2011))-> [("with u as (select a from t) select a from u"-> ,With False [(Alias (Name "u") Nothing, ms1)] ms2)--> ,("with u(b) as (select a from t) select a from u"-> ,With False [(Alias (Name "u") (Just [Name "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 "x") Nothing, ms1), (Alias (Name "u") Nothing,ms3)] ms2)--> ,("with recursive u as (select a from t) select a from u"-> ,With True [(Alias (Name "u") Nothing, ms1)] ms2)-> ]-> where-> ms c t = makeSelect-> {qeSelectList = [(Iden [Name c],Nothing)]-> ,qeFrom = [TRSimple [Name t]]}-> ms1 = ms "a" "t"-> ms2 = ms "a" "u"-> ms3 = ms "a" "x"--> values :: TestItem-> values = Group "values" $ map (uncurry (TestQueryExpr SQL2011))-> [("values (1,2),(3,4)"-> ,Values [[NumLit "1", NumLit "2"]-> ,[NumLit "3", NumLit "4"]])-> ]--> tables :: TestItem-> tables = Group "tables" $ map (uncurry (TestQueryExpr SQL2011))-> [("table tbl", Table [Name "tbl"])-> ]
− tools/Language/SQL/SimpleSQL/QueryExprs.lhs
@@ -1,18 +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 (TestQueryExprs SQL2011))-> [("select 1",[ms])-> ,("select 1;",[ms])-> ,("select 1;select 1",[ms,ms])-> ,(" select 1;select 1; ",[ms,ms])-> ]-> where-> ms = makeSelect {qeSelectList = [(NumLit "1",Nothing)]}
− tools/Language/SQL/SimpleSQL/SQL2011.lhs
@@ -1,4309 +0,0 @@--This file goes through the grammar for SQL 2011 (using the draft standard).--We are only looking at the query syntax, and no other parts.--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.SQL2011 (sql2011Tests) where-> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> sql2011Tests :: TestItem-> sql2011Tests = Group "sql 2011 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 (TestValueExpr SQL2011))-> [("'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 "_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 (TestValueExpr SQL2011))-> [("N'something'", CSStringLit "N" "something")-> ,("n'something'", CSStringLit "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 (TestValueExpr SQL2011))-> [("U&'something'", CSStringLit "U&" "something")-> ,("u&'something' escape ="-> ,Escape (CSStringLit "u&" "something") '=')-> ,("u&'something' uescape ="-> ,UEscape (CSStringLit "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 (TestValueExpr SQL2011))-> [--("B'101010'", CSStringLit "B" "101010")-> ("X'7f7f7f'", CSStringLit "X" "7f7f7f")-> ,("X'7f7f7f' escape z", Escape (CSStringLit "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 (TestValueExpr SQL2011))-> [("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 "+"] $ NumLit "11E23")-> ,("+11E+23", PrefixOp [Name "+"] $ NumLit "11E+23")-> ,("+11E-23", PrefixOp [Name "+"] $ NumLit "11E-23")-> ,("+11.11E23", PrefixOp [Name "+"] $ NumLit "11.11E23")-> ,("+11.11E+23", PrefixOp [Name "+"] $ NumLit "11.11E+23")-> ,("+11.11E-23", PrefixOp [Name "+"] $ NumLit "11.11E-23")--> ,("-11E23", PrefixOp [Name "-"] $ NumLit "11E23")-> ,("-11E+23", PrefixOp [Name "-"] $ NumLit "11E+23")-> ,("-11E-23", PrefixOp [Name "-"] $ NumLit "11E-23")-> ,("-11.11E23", PrefixOp [Name "-"] $ NumLit "11.11E23")-> ,("-11.11E+23", PrefixOp [Name "-"] $ NumLit "11.11E+23")-> ,("-11.11E-23", PrefixOp [Name "-"] $ 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 (TestValueExpr SQL2011))-> [("interval '1'", TypedLit (TypeName [Name "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 True) "1" (Itf "day" $ Just (3,Nothing)) Nothing)-> ,("interval - '1' second(2,2)"-> ,IntervalLit (Just False) "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 (TestValueExpr SQL2011))-> [("true", Iden [Name "true"])-> ,("false", Iden [Name "false"])-> ,("unknown", Iden [Name "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 (TestValueExpr SQL2011))-> [("test",Iden [Name "test"])-> ,("_test",Iden [Name "_test"])-> ,("t1",Iden [Name "t1"])-> ,("a.b",Iden [Name "a", Name "b"])-> ,("a.b.c",Iden [Name "a", Name "b", Name "c"])-> ,("\"quoted iden\"", Iden [QName "quoted iden"])-> ,("\"quoted \"\" iden\"", Iden [QName "quoted \" iden"])-> ,("U&\"quoted iden\"", Iden [UQName "quoted iden"])-> ,("U&\"quoted \"\" iden\"", Iden [UQName "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)]-> 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 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 "char"] 5)-> ,("char varying(5)", PrecTypeName [Name "char varying"] 5)-> -- 1 scale-> ,("decimal(15,2)", PrecScaleTypeName [Name "decimal"] 15 2)-> ,("char(3 octets)"-> ,PrecLengthTypeName [Name "char"] 3 Nothing (Just PrecOctets))-> ,("varchar(50 characters)"-> ,PrecLengthTypeName [Name "varchar"] 50 Nothing (Just PrecCharacters))-> -- lob prec + with multiname-> ,("blob(3M)", PrecLengthTypeName [Name "blob"] 3 (Just PrecM) Nothing)-> ,("blob(3T)", PrecLengthTypeName [Name "blob"] 3 (Just PrecT) Nothing)-> ,("blob(3P)", PrecLengthTypeName [Name "blob"] 3 (Just PrecP) Nothing)-> ,("blob(4M characters) "-> ,PrecLengthTypeName [Name "blob"] 4 (Just PrecM) (Just PrecCharacters))-> ,("blob(6G octets) "-> ,PrecLengthTypeName [Name "blob"] 6 (Just PrecG) (Just PrecOctets))-> ,("national character large object(7K) "-> ,PrecLengthTypeName [Name "national character large object"]-> 7 (Just PrecK) Nothing)-> -- 1 with and without tz-> ,("time with time zone"-> ,TimeTypeName [Name "time"] Nothing True)-> ,("datetime(3) without time zone"-> ,TimeTypeName [Name "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 "char varying"] (Just 5)-> [Name "something"] [Name "something_insensitive"])-> -- 0111-> ,("char(5) character set something collate something_insensitive"-> ,CharTypeName [Name "char"] (Just 5)-> [Name "something"] [Name "something_insensitive"])--> -- 1011-> ,("char varying character set something collate something_insensitive"-> ,CharTypeName [Name "char varying"] Nothing-> [Name "something"] [Name "something_insensitive"])-> -- 0011-> ,("char character set something collate something_insensitive"-> ,CharTypeName [Name "char"] Nothing-> [Name "something"] [Name "something_insensitive"])--> -- 1101-> ,("char varying(5) collate something_insensitive"-> ,CharTypeName [Name "char varying"] (Just 5)-> [] [Name "something_insensitive"])-> -- 0101-> ,("char(5) collate something_insensitive"-> ,CharTypeName [Name "char"] (Just 5)-> [] [Name "something_insensitive"])-> -- 1001-> ,("char varying collate something_insensitive"-> ,CharTypeName [Name "char varying"] Nothing-> [] [Name "something_insensitive"])-> -- 0001-> ,("char collate something_insensitive"-> ,CharTypeName [Name "char"] Nothing-> [] [Name "something_insensitive"])--> -- 1110-> ,("char varying(5) character set something"-> ,CharTypeName [Name "char varying"] (Just 5)-> [Name "something"] [])-> -- 0110-> ,("char(5) character set something"-> ,CharTypeName [Name "char"] (Just 5)-> [Name "something"] [])-> -- 1010-> ,("char varying character set something"-> ,CharTypeName [Name "char varying"] Nothing-> [Name "something"] [])-> -- 0010-> ,("char character set something"-> ,CharTypeName [Name "char"] Nothing-> [Name "something"] [])-> -- 1100-> ,("char varying character set something"-> ,CharTypeName [Name "char varying"] Nothing-> [Name "something"] [])--> -- single row field, two row field-> ,("row(a int)", RowTypeName [(Name "a", TypeName [Name "int"])])-> ,("row(a int,b char)"-> ,RowTypeName [(Name "a", TypeName [Name "int"])-> ,(Name "b", TypeName [Name "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" $ map (uncurry (TestValueExpr SQL2011))-> $ concatMap makeTests typeNames-> where-> makeTests (ctn, stn) =-> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "test") stn)-> ,(ctn ++ " 'test'", TypedLit stn "test")-> ]---== 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 (TestValueExpr SQL2011))-> [("cast('(1,2)' as row(a int,b char))"-> ,Cast (StringLit "(1,2)")-> $ RowTypeName [(Name "a", TypeName [Name "int"])-> ,(Name "b", TypeName [Name "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-> ,nextValueExpression-> ,fieldReference-> ,arrayElementReference-> ,multisetElementReference-> ,numericValueExpression-> ,numericValueFunction-> ,stringValueExpression-> ,stringValueFunction-> ,datetimeValueExpression-> ,datetimeValueFunction-> ,intervalValueExpression-> ,intervalValueFunction-> ,booleanValueExpression-> ,arrayValueExpression-> ,arrayValueFunction-> ,arrayValueConstructor-> ,multisetValueExpression-> ,multisetValueFunction-> ,multisetValueConstructor-> ,parenthesizedValueExpression-> ]--> parenthesizedValueExpression :: TestItem-> parenthesizedValueExpression = Group "parenthesized value expression"-> $ map (uncurry (TestValueExpr SQL2011))-> [("(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 (TestValueExpr SQL2011)) $-> map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"-> ,"CURRENT_PATH"-> ,"CURRENT_ROLE"-> ,"CURRENT_USER"-> ,"SESSION_USER"-> ,"SYSTEM_USER"-> ,"USER"-> ,"VALUE"]-> where-> mkIden nm = (nm,Iden [Name 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 (TestValueExpr SQL2011))-> [(":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 (TestValueExpr SQL2011))-> [("null", Iden [Name "null"])-> ,("array[]", Array (Iden [Name "array"]) [])-> ,("multiset[]", MultisetCtor [])-> ,("default", Iden [Name "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 (TestValueExpr SQL2011))-> [("a.b", Iden [Name "a",Name "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 (TestValueExpr SQL2011))-> [("module.a.b", Iden [Name "module",Name "a",Name "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 SQL2011))-> [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\-> \ GROUPING(SalesQuota) AS Grouping\n\-> \FROM Sales.SalesPerson\n\-> \GROUP BY ROLLUP(SalesQuota);"-> ,makeSelect-> {qeSelectList = [(Iden [Name "SalesQuota"],Nothing)-> ,(App [Name "SUM"] [Iden [Name "SalesYTD"]]-> ,Just (Name "TotalSalesYTD"))-> ,(App [Name "GROUPING"] [Iden [Name "SalesQuota"]]-> ,Just (Name "Grouping"))]-> ,qeFrom = [TRSimple [Name "Sales",Name "SalesPerson"]]-> ,qeGroupBy = [Rollup [SimpleGroup (Iden [Name "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 (TestValueExpr SQL2011))-> [("cast(a as int)"-> ,Cast (Iden [Name "a"]) (TypeName [Name "int"]))-> ]--== 6.14 <next value expression>--Function-Return the next value of a sequence generator.--<next value expression> ::= NEXT VALUE FOR <sequence generator name>--> nextValueExpression :: TestItem-> nextValueExpression = Group "next value expression"-> $ map (uncurry (TestValueExpr SQL2011))-> [("next value for a.b", NextValueFor [Name "a", Name "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 (TestValueExpr SQL2011))-> [("f(something).a"-> ,BinOp (App [Name "f"] [Iden [Name "something"]])-> [Name "."]-> (Iden [Name "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 (TestValueExpr SQL2011))-> [("something[3]"-> ,Array (Iden [Name "something"]) [NumLit "3"])-> ,("(something(a))[x]"-> ,Array (Parens (App [Name "something"] [Iden [Name "a"]]))-> [Iden [Name "x"]])-> ,("(something(a))[x][y] "-> ,Array (-> Array (Parens (App [Name "something"] [Iden [Name "a"]]))-> [Iden [Name "x"]])-> [Iden [Name "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 (TestValueExpr SQL2011))-> [("element(something)"-> ,App [Name "element"] [Iden [Name "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>--> numericValueExpression :: TestItem-> numericValueExpression = Group "numeric value expression"-> $ map (uncurry (TestValueExpr SQL2011))-> [("a + b", binOp "+")-> ,("a - b", binOp "-")-> ,("a * b", binOp "*")-> ,("a / b", binOp "/")-> ,("+a", prefOp "+")-> ,("-a", prefOp "-")-> ]-> where-> binOp o = BinOp (Iden [Name "a"]) [Name o] (Iden [Name "b"])-> prefOp o = PrefixOp [Name o] (Iden [Name "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>--> stringValueExpression :: TestItem-> stringValueExpression = 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>--> datetimeValueExpression :: TestItem-> datetimeValueExpression = 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>--> intervalValueExpression :: TestItem-> intervalValueExpression = 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>---> booleanValueExpression :: TestItem-> booleanValueExpression = Group "booleab value expression"-> $ map (uncurry (TestValueExpr SQL2011))-> [("a or b", BinOp a [Name "or"] b)-> ,("a and b", BinOp a [Name "and"] b)-> ,("not a", PrefixOp [Name "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 "or"] b)-> ]-> where-> a = Iden [Name "a"]-> b = Iden [Name "b"]-> postfixOp nm = PostfixOp [Name 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>--> arrayValueExpression :: TestItem-> arrayValueExpression = 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 (TestValueExpr SQL2011))-> [("array[1,2,3]"-> ,Array (Iden [Name "array"])-> [NumLit "1", NumLit "2", NumLit "3"])-> ,("array[a,b,c]"-> ,Array (Iden [Name "array"])-> [Iden [Name "a"], Iden [Name "b"], Iden [Name "c"]])-> ,("array(select * from t)"-> ,ArrayCtor (makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]}))-> ,("array(select * from t order by a)"-> ,ArrayCtor (makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeOrderBy = [SortSpec (Iden [Name "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>--> multisetValueExpression :: TestItem-> multisetValueExpression = Group "multiset value expression"-> $ map (uncurry (TestValueExpr SQL2011))-> [("a multiset union b"-> ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"]))-> ,("a multiset union all b"-> ,MultisetBinOp (Iden [Name "a"]) Union All (Iden [Name "b"]))-> ,("a multiset union distinct b"-> ,MultisetBinOp (Iden [Name "a"]) Union Distinct (Iden [Name "b"]))-> ,("a multiset except b"-> ,MultisetBinOp (Iden [Name "a"]) Except SQDefault (Iden [Name "b"]))-> ,("a multiset intersect b"-> ,MultisetBinOp (Iden [Name "a"]) Intersect SQDefault (Iden [Name "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>--> multisetValueFunction :: TestItem-> multisetValueFunction = Group "multiset value function"-> $ map (uncurry (TestValueExpr SQL2011))-> [("set(a)", App [Name "set"] [Iden [Name "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 (TestValueExpr SQL2011))-> [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"]-> ,Iden [Name "b"], Iden [Name "c"]])-> ,("multiset(select * from t)", MultisetQueryCtor qe)-> ,("table(select * from t)", MultisetQueryCtor qe)-> ]-> where-> qe = makeSelect {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "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 (TestValueExpr SQL2011))-> [("(a,b)"-> ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]])-> ,("row(1)",App [Name "row"] [NumLit "1"])-> ,("row(1,2)",App [Name "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 SQL2011))-> [("values (1,2), (a+b,(select count(*) from t));"-> ,Values [[NumLit "1", NumLit "2"]-> ,[BinOp (Iden [Name "a"]) [Name "+"]-> (Iden [Name "b"])-> ,SubQueryExpr SqSq-> (makeSelect-> {qeSelectList = [(App [Name "count"] [Star],Nothing)]-> ,qeFrom = [TRSimple [Name "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 SQL2011))-> [("select * from tbl1,tbl2"-> ,makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRSimple [Name "tbl1"], TRSimple [Name "tbl2"]]-> })]---== 7.6 <table reference>--Function-Reference a table.--> tableReference :: TestItem-> tableReference = Group "table reference"-> $ map (uncurry (TestQueryExpr SQL2011))-> [("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 "t"]]}-> af f s = s {qeFrom = map f (qeFrom s)}-> a s = af (\x -> TRAlias x $ Alias (Name "u") Nothing) s-> sel1 = makeSelect-> {qeSelectList = [(Star, Nothing)]-> ,qeFrom = [TRAlias (TRSimple [Name "t"])-> $ Alias (Name "u") $ Just [Name "a", Name "b"]]}-> jsel = sel {qeFrom =-> [TRParens $ TRJoin (TRSimple [Name "a"])-> False-> JInner-> (TRSimple [Name "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 SQL2011))-> [("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 "true"]))-> ,("select * from a join b using (c)"-> ,sel $ TRJoin a False JInner b-> (Just $ JoinUsing [Name "c"]))-> ,("select * from a inner join b on true"-> ,sel $ TRJoin a False JInner b-> (Just $ JoinOn $ Iden [Name "true"]))-> ,("select * from a left join b on true"-> ,sel $ TRJoin a False JLeft b-> (Just $ JoinOn $ Iden [Name "true"]))-> ,("select * from a left outer join b on true"-> ,sel $ TRJoin a False JLeft b-> (Just $ JoinOn $ Iden [Name "true"]))-> ,("select * from a right join b on true"-> ,sel $ TRJoin a False JRight b-> (Just $ JoinOn $ Iden [Name "true"]))-> ,("select * from a full join b on true"-> ,sel $ TRJoin a False JFull b-> (Just $ JoinOn $ Iden [Name "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 "a"]-> b = TRSimple [Name "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 SQL2011))-> [("select * from t where a = 5"-> ,makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name "="] (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 SQL2011))-> [("select a,sum(x) from t group by a"-> ,qe [SimpleGroup $ Iden [Name "a"]])-> ,("select a,sum(x) from t group by a collate c"-> ,qe [SimpleGroup $ Collate (Iden [Name "a"]) [Name "c"]])-> ,("select a,b,sum(x) from t group by a,b"-> ,qex [SimpleGroup $ Iden [Name "a"]-> ,SimpleGroup $ Iden [Name "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 "a"]-> ,SimpleGroup $ Iden [Name "b"]]])-> ,("select a,b,sum(x) from t group by cube(a,b)"-> ,qex [Cube [SimpleGroup $ Iden [Name "a"]-> ,SimpleGroup $ Iden [Name "b"]]])-> ,("select a,b,sum(x) from t group by grouping sets((),(a,b))"-> ,qex [GroupingSets [GroupingParens []-> ,GroupingParens [SimpleGroup $ Iden [Name "a"]-> ,SimpleGroup $ Iden [Name "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 "a"], Nothing)-> ,(App [Name "sum"] [Iden [Name "x"]], Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeGroupBy = g}-> qex g = let x = qe g-> in x {qeSelectList = let [a,b] = qeSelectList x-> in [a,(Iden [Name "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 SQL2011))-> [("select a,sum(x) from t group by a having sum(x) > 1000"-> ,makeSelect-> {qeSelectList = [(Iden [Name "a"], Nothing)-> ,(App [Name "sum"] [Iden [Name "x"]], Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]]-> ,qeHaving = Just $ BinOp (App [Name "sum"] [Iden [Name "x"]])-> [Name ">"]-> (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 SQL2011))-> [("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 "a"]) [Name "."] Star-> ,Nothing)]})-> ,("select a b from t"-> ,qe {qeSelectList = [(Iden [Name "a"], Just $ Name "b")]})-> ,("select a as b from t"-> ,qe {qeSelectList = [(Iden [Name "a"], Just $ Name "b")]})-> ,("select a,b from t"-> ,qe {qeSelectList = [(Iden [Name "a"], Nothing)-> ,(Iden [Name "b"], Nothing)]})-> -- todo: all field reference alias-> --,("select * as (a,b) from t",undefined)-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Iden [Name "a"], Nothing)]-> ,qeFrom = [TRSimple [Name "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 SQL2011))-> -- 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 SQL2011))-> [("table t", Table [Name "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 SQL2011))-> [-- todo: finish tests for order offset and fetch-> ("select a from t order by a"-> ,qe {qeOrderBy = [SortSpec (Iden [Name "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 "a"], Nothing)]-> ,qeFrom = [TRSimple [Name "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 (TestValueExpr SQL2011))-> $ map mkOp ["=", "<>", "<", ">", "<=", ">="]-> ++ [("ROW(a) = ROW(b)"-> ,BinOp (App [Name "ROW"] [a])-> [Name "="]-> (App [Name "ROW"] [b]))-> ,("(a,b) = (c,d)"-> ,BinOp (SpecialOp [Name "rowctor"] [a,b])-> [Name "="]-> (SpecialOp [Name "rowctor"] [Iden [Name "c"], Iden [Name "d"]]))-> ]-> where-> mkOp nm = ("a " ++ nm ++ " b"-> ,BinOp a [Name nm] b)-> a = Iden [Name "a"]-> b = Iden [Name "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 (TestValueExpr SQL2011))--> [("a = any (select * from t)"-> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe)-> ,("a <= some (select * from t)"-> ,QuantifiedComparison (Iden [Name "a"]) [Name "<="] CPSome qe)-> ,("a > all (select * from t)"-> ,QuantifiedComparison (Iden [Name "a"]) [Name ">"] CPAll qe)-> ,("(a,b) <> all (select * from t)"-> ,QuantifiedComparison-> (SpecialOp [Name "rowctor"] [Iden [Name "a"]-> ,Iden [Name "b"]]) [Name "<>"] CPAll qe)-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "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 (TestValueExpr SQL2011))-> [("exists(select * from t where a = 4)"-> ,SubQueryExpr SqExists-> $ makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeWhere = Just (BinOp (Iden [Name "a"]) [Name "="] (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 (TestValueExpr SQL2011))-> [("unique(select * from t where a = 4)"-> ,SubQueryExpr SqUnique-> $ makeSelect-> {qeSelectList = [(Star,Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> ,qeWhere = Just (BinOp (Iden [Name "a"]) [Name "="] (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 (TestValueExpr SQL2011))-> [("a match (select a from t)"-> ,Match (Iden [Name "a"]) False qe)-> ,("(a,b) match (select a,b from t)"-> ,Match (SpecialOp [Name "rowctor"]-> [Iden [Name "a"], Iden [Name "b"]]) False qea)-> ,("(a,b) match unique (select a,b from t)"-> ,Match (SpecialOp [Name "rowctor"]-> [Iden [Name "a"], Iden [Name "b"]]) True qea)-> ]-> where-> qe = makeSelect-> {qeSelectList = [(Iden [Name "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]}-> qea = qe {qeSelectList = qeSelectList qe-> ++ [(Iden [Name "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 (TestValueExpr SQL2011))-> [("a collate my_collation"-> ,Collate (Iden [Name "a"]) [Name "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 (TestValueExpr SQL2011)) $-> [("count(*)",App [Name "count"] [Star])-> ,("count(*) filter (where something > 5)"-> ,AggregateApp [Name "count"] SQDefault [Star] [] fil)--gsf--> ,("count(a)",App [Name "count"] [Iden [Name "a"]])-> ,("count(distinct a)"-> ,AggregateApp [Name "count"]-> Distinct-> [Iden [Name "a"]] [] Nothing)-> ,("count(all a)"-> ,AggregateApp [Name "count"]-> All-> [Iden [Name "a"]] [] Nothing)-> ,("count(all a) filter (where something > 5)"-> ,AggregateApp [Name "count"]-> All-> [Iden [Name "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 "rank"]-> [Iden [Name "a"], Iden [Name "c"]]-> ob)]-> ++ map mkGp ["dense_rank","percent_rank"-> ,"cume_dist", "percentile_cont"-> ,"percentile_disc"]-> ++ [("array_agg(a)", App [Name "array_agg"] [Iden [Name "a"]])-> ,("array_agg(a order by z)"-> ,AggregateApp [Name "array_agg"]-> SQDefault-> [Iden [Name "a"]]-> [SortSpec (Iden [Name "z"])-> DirDefault NullsOrderDefault]-> Nothing)]--> where-> fil = Just $ BinOp (Iden [Name "something"]) [Name ">"] (NumLit "5")-> ob = [SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault]-> mkGp nm = (nm ++ "(a) within group (order by b)"-> ,AggregateAppGroup [Name nm]-> [Iden [Name "a"]]-> ob)--> mkSimpleAgg nm =-> [(nm ++ "(a)",App [Name nm] [Iden [Name "a"]])-> ,(nm ++ "(distinct a)"-> ,AggregateApp [Name nm]-> Distinct-> [Iden [Name "a"]] [] Nothing)]-> mkBsf nm =-> [(nm ++ "(a,b)",App [Name nm] [Iden [Name "a"],Iden [Name "b"]])-> ,(nm ++"(a,b) filter (where something > 5)"-> ,AggregateApp [Name nm]-> SQDefault-> [Iden [Name "a"],Iden [Name "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 SQL2011))-> [("select * from t order by a"-> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a,b"-> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])-> DirDefault NullsOrderDefault-> ,SortSpec (Iden [Name "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a asc,b"-> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])-> Asc NullsOrderDefault-> ,SortSpec (Iden [Name "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a desc,b"-> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])-> Desc NullsOrderDefault-> ,SortSpec (Iden [Name "b"])-> DirDefault NullsOrderDefault]})-> ,("select * from t order by a collate x desc,b"-> ,qe {qeOrderBy = [SortSpec-> (Collate (Iden [Name "a"]) [Name "x"])-> Desc NullsOrderDefault-> ,SortSpec (Iden [Name "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 "t"]]}
− 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 SQL2011))-> [("select a from t"-> ,ms [TRSimple [Name "t"]])--> ,("select a from f(a)"-> ,ms [TRFunction [Name "f"] [Iden [Name "a"]]])--> ,("select a from t,u"-> ,ms [TRSimple [Name "t"], TRSimple [Name "u"]])--> ,("select a from s.t"-> ,ms [TRSimple [Name "s", Name "t"]])--these lateral queries make no sense but the syntax is valid--> ,("select a from lateral a"-> ,ms [TRLateral $ TRSimple [Name "a"]])--> ,("select a from lateral a,b"-> ,ms [TRLateral $ TRSimple [Name "a"], TRSimple [Name "b"]])--> ,("select a from a, lateral b"-> ,ms [TRSimple [Name "a"], TRLateral $ TRSimple [Name "b"]])--> ,("select a from a natural join lateral b"-> ,ms [TRJoin (TRSimple [Name "a"]) True JInner-> (TRLateral $ TRSimple [Name "b"])-> Nothing])--> ,("select a from lateral a natural join lateral b"-> ,ms [TRJoin (TRLateral $ TRSimple [Name "a"]) True JInner-> (TRLateral $ TRSimple [Name "b"])-> Nothing])---> ,("select a from t inner join u on expr"-> ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])-> (Just $ JoinOn $ Iden [Name "expr"])])--> ,("select a from t join u on expr"-> ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])-> (Just $ JoinOn $ Iden [Name "expr"])])--> ,("select a from t left join u on expr"-> ,ms [TRJoin (TRSimple [Name "t"]) False JLeft (TRSimple [Name "u"])-> (Just $ JoinOn $ Iden [Name "expr"])])--> ,("select a from t right join u on expr"-> ,ms [TRJoin (TRSimple [Name "t"]) False JRight (TRSimple [Name "u"])-> (Just $ JoinOn $ Iden [Name "expr"])])--> ,("select a from t full join u on expr"-> ,ms [TRJoin (TRSimple [Name "t"]) False JFull (TRSimple [Name "u"])-> (Just $ JoinOn $ Iden [Name "expr"])])--> ,("select a from t cross join u"-> ,ms [TRJoin (TRSimple [Name "t"]) False-> JCross (TRSimple [Name "u"]) Nothing])--> ,("select a from t natural inner join u"-> ,ms [TRJoin (TRSimple [Name "t"]) True JInner (TRSimple [Name "u"])-> Nothing])--> ,("select a from t inner join u using(a,b)"-> ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])-> (Just $ JoinUsing [Name "a", Name "b"])])--> ,("select a from (select a from t)"-> ,ms [TRQueryExpr $ ms [TRSimple [Name "t"]]])--> ,("select a from t as u"-> ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)])--> ,("select a from t u"-> ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)])--> ,("select a from t u(b)"-> ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") $ Just [Name "b"])])--> ,("select a from (t cross join u) as u"-> ,ms [TRAlias (TRParens $-> TRJoin (TRSimple [Name "t"]) False JCross (TRSimple [Name "u"]) Nothing)-> (Alias (Name "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 "t"]) False-> JCross (TRSimple [Name "u"]) Nothing)-> False JCross (TRSimple [Name "v"]) Nothing])-> ]-> where-> ms f = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]-> ,qeFrom = f}
− tools/Language/SQL/SimpleSQL/TestTypes.lhs
@@ -1,31 +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(..)-> ,Dialect(..)) where--> import Language.SQL.SimpleSQL.Syntax--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]-> | TestValueExpr Dialect String ValueExpr-> | TestQueryExpr Dialect String QueryExpr-> | TestQueryExprs Dialect String [QueryExpr]--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-> | ParseValueExprFails Dialect String-> deriving (Eq,Show)
− tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -1,132 +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 Test.Framework-> import Test.Framework.Providers.HUnit-> import qualified Test.HUnit as H--> --import Language.SQL.SimpleSQL.Syntax-> import Language.SQL.SimpleSQL.Pretty-> import Language.SQL.SimpleSQL.Parser--> 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.ValueExprs-> import Language.SQL.SimpleSQL.Tpch--> import Language.SQL.SimpleSQL.SQL2011--> import Language.SQL.SimpleSQL.MySQL--Order the tests to start from the simplest first. This is also the-order on the generated documentation.--> testData :: TestItem-> testData =-> Group "parserTest"-> [valueExprTests-> ,queryExprComponentTests-> ,queryExprsTests-> ,tableRefTests-> ,groupByTests-> ,fullQueriesTests-> ,postgresTests-> ,tpchTests-> ,sql2011Tests-> ,mySQLTests-> ]--> tests :: Test.Framework.Test-> tests = itemToTest testData--> --runTests :: IO ()-> --runTests = void $ H.runTestTT $ itemToTest testData--> itemToTest :: TestItem -> Test.Framework.Test-> itemToTest (Group nm ts) =-> testGroup nm $ map itemToTest ts-> itemToTest (TestValueExpr d str expected) =-> toTest parseValueExpr prettyValueExpr d str expected-> itemToTest (TestQueryExpr d str expected) =-> toTest parseQueryExpr prettyQueryExpr d str expected-> itemToTest (TestQueryExprs d str expected) =-> toTest parseQueryExprs prettyQueryExprs d str expected-> itemToTest (ParseQueryExpr d str) =-> toPTest parseQueryExpr prettyQueryExpr d str--> itemToTest (ParseQueryExprFails d str) =-> toFTest parseQueryExpr prettyQueryExpr d str--> itemToTest (ParseValueExprFails d str) =-> toFTest parseValueExpr prettyValueExpr d str---> toTest :: (Eq a, Show a) =>-> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)-> -> (Dialect -> a -> String)-> -> Dialect-> -> String-> -> a-> -> Test.Framework.Test-> toTest parser pp d str expected = 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-> -> Test.Framework.Test-> toPTest parser pp d str = 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-> -> Test.Framework.Test-> toFTest parser pp d str = 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 SQL2011 . 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/Language/SQL/SimpleSQL/ValueExprs.lhs
@@ -1,406 +0,0 @@--Tests for parsing value expressions--> module Language.SQL.SimpleSQL.ValueExprs (valueExprTests) where--> import Language.SQL.SimpleSQL.TestTypes-> import Language.SQL.SimpleSQL.Syntax--> valueExprTests :: TestItem-> valueExprTests = Group "valueExprTests"-> [literals-> ,identifiers-> ,star-> ,parameter-> ,dots-> ,app-> ,caseexp-> ,operators-> ,parens-> ,subqueries-> ,aggregates-> ,windowFunctions-> ]--> literals :: TestItem-> literals = Group "literals" $ map (uncurry (TestValueExpr SQL2011))-> [("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 "interval"]) "3 weeks")-> ]--> identifiers :: TestItem-> identifiers = Group "identifiers" $ map (uncurry (TestValueExpr SQL2011))-> [("iden1", Iden [Name "iden1"])-> --,("t.a", Iden2 "t" "a")-> ,("\"quoted identifier\"", Iden [QName "quoted identifier"])-> ]--> star :: TestItem-> star = Group "star" $ map (uncurry (TestValueExpr SQL2011))-> [("*", Star)-> --,("t.*", Star2 "t")-> --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])-> ]--> parameter :: TestItem-> parameter = Group "parameter" $ map (uncurry (TestValueExpr SQL2011))-> [("?", Parameter)-> ]---> dots :: TestItem-> dots = Group "dot" $ map (uncurry (TestValueExpr SQL2011))-> [("t.a", Iden [Name "t",Name "a"])-> ,("t.*", BinOp (Iden [Name "t"]) [Name "."] Star)-> ,("a.b.c", Iden [Name "a",Name "b",Name "c"])-> ,("ROW(t.*,42)", App [Name "ROW"] [BinOp (Iden [Name "t"]) [Name "."] Star, NumLit "42"])-> ]--> app :: TestItem-> app = Group "app" $ map (uncurry (TestValueExpr SQL2011))-> [("f()", App [Name "f"] [])-> ,("f(a)", App [Name "f"] [Iden [Name "a"]])-> ,("f(a,b)", App [Name "f"] [Iden [Name "a"], Iden [Name "b"]])-> ]--> caseexp :: TestItem-> caseexp = Group "caseexp" $ map (uncurry (TestValueExpr SQL2011))-> [("case a when 1 then 2 end"-> ,Case (Just $ Iden [Name "a"]) [([NumLit "1"]-> ,NumLit "2")] Nothing)--> ,("case a when 1 then 2 when 3 then 4 end"-> ,Case (Just $ Iden [Name "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 "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 "a"]) [Name "="] (NumLit "1")], NumLit "2")-> ,([BinOp (Iden [Name "a"]) [Name "="] (NumLit "3")], NumLit "4")]-> (Just $ NumLit "5"))--> ,("case a when 1,2 then 10 when 3,4 then 20 end"-> ,Case (Just $ Iden [Name "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 (TestValueExpr SQL2011))-> [("a + b", BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"]))-> -- sanity check fixities-> -- todo: add more fixity checking--> ,("a + b * c"-> ,BinOp (Iden [Name "a"]) [Name "+"]-> (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"])))--> ,("a * b + c"-> ,BinOp (BinOp (Iden [Name "a"]) [Name "*"] (Iden [Name "b"]))-> [Name "+"] (Iden [Name "c"]))-> ]--> unaryOperators :: TestItem-> unaryOperators = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))-> [("not a", PrefixOp [Name "not"] $ Iden [Name "a"])-> ,("not not a", PrefixOp [Name "not"] $ PrefixOp [Name "not"] $ Iden [Name "a"])-> ,("+a", PrefixOp [Name "+"] $ Iden [Name "a"])-> ,("-a", PrefixOp [Name "-"] $ Iden [Name "a"])-> ]---> casts :: TestItem-> casts = Group "operators" $ map (uncurry (TestValueExpr SQL2011))-> [("cast('1' as int)"-> ,Cast (StringLit "1") $ TypeName [Name "int"])--> ,("int '3'"-> ,TypedLit (TypeName [Name "int"]) "3")--> ,("cast('1' as double precision)"-> ,Cast (StringLit "1") $ TypeName [Name "double precision"])--> ,("cast('1' as float(8))"-> ,Cast (StringLit "1") $ PrecTypeName [Name "float"] 8)--> ,("cast('1' as decimal(15,2))"-> ,Cast (StringLit "1") $ PrecScaleTypeName [Name "decimal"] 15 2)---> ,("double precision '3'"-> ,TypedLit (TypeName [Name "double precision"]) "3")-> ]--> subqueries :: TestItem-> subqueries = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))-> [("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 "a"]) (InQueryExpr ms))--> ,("a not in (select a from t)"-> ,In False (Iden [Name "a"]) (InQueryExpr ms))--> ,("a > all (select a from t)"-> ,QuantifiedComparison (Iden [Name "a"]) [Name ">"] CPAll ms)--> ,("a = some (select a from t)"-> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPSome ms)--> ,("a <= any (select a from t)"-> ,QuantifiedComparison (Iden [Name "a"]) [Name "<="] CPAny ms)-> ]-> where-> ms = makeSelect-> {qeSelectList = [(Iden [Name "a"],Nothing)]-> ,qeFrom = [TRSimple [Name "t"]]-> }--> miscOps :: TestItem-> miscOps = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))-> [("a in (1,2,3)"-> ,In True (Iden [Name "a"]) $ InList $ map NumLit ["1","2","3"])--> ,("a is null", PostfixOp [Name "is null"] (Iden [Name "a"]))-> ,("a is not null", PostfixOp [Name "is not null"] (Iden [Name "a"]))-> ,("a is true", PostfixOp [Name "is true"] (Iden [Name "a"]))-> ,("a is not true", PostfixOp [Name "is not true"] (Iden [Name "a"]))-> ,("a is false", PostfixOp [Name "is false"] (Iden [Name "a"]))-> ,("a is not false", PostfixOp [Name "is not false"] (Iden [Name "a"]))-> ,("a is unknown", PostfixOp [Name "is unknown"] (Iden [Name "a"]))-> ,("a is not unknown", PostfixOp [Name "is not unknown"] (Iden [Name "a"]))-> ,("a is distinct from b", BinOp (Iden [Name "a"]) [Name "is distinct from"] (Iden [Name "b"]))--> ,("a is not distinct from b"-> ,BinOp (Iden [Name "a"]) [Name "is not distinct from"] (Iden [Name "b"]))--> ,("a like b", BinOp (Iden [Name "a"]) [Name "like"] (Iden [Name "b"]))-> ,("a not like b", BinOp (Iden [Name "a"]) [Name "not like"] (Iden [Name "b"]))-> ,("a is similar to b", BinOp (Iden [Name "a"]) [Name "is similar to"] (Iden [Name "b"]))--> ,("a is not similar to b"-> ,BinOp (Iden [Name "a"]) [Name "is not similar to"] (Iden [Name "b"]))--> ,("a overlaps b", BinOp (Iden [Name "a"]) [Name "overlaps"] (Iden [Name "b"]))---special operators--> ,("a between b and c", SpecialOp [Name "between"] [Iden [Name "a"]-> ,Iden [Name "b"]-> ,Iden [Name "c"]])--> ,("a not between b and c", SpecialOp [Name "not between"] [Iden [Name "a"]-> ,Iden [Name "b"]-> ,Iden [Name "c"]])-> ,("(1,2)"-> ,SpecialOp [Name "rowctor"] [NumLit "1", NumLit "2"])---keyword special operators--> ,("extract(day from t)"-> , SpecialOpK [Name "extract"] (Just $ Iden [Name "day"]) [("from", Iden [Name "t"])])--> ,("substring(x from 1 for 2)"-> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("from", NumLit "1")-> ,("for", NumLit "2")])--> ,("substring(x from 1)"-> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("from", NumLit "1")])--> ,("substring(x for 2)"-> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("for", NumLit "2")])--> ,("substring(x from 1 for 2 collate C)"-> ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"])-> [("from", NumLit "1")-> ,("for", Collate (NumLit "2") [Name "C"])])--this doesn't work because of a overlap in the 'in' parser--> ,("POSITION( string1 IN string2 )"-> ,SpecialOpK [Name "position"] (Just $ Iden [Name "string1"]) [("in", Iden [Name "string2"])])--> ,("CONVERT(char_value USING conversion_char_name)"-> ,SpecialOpK [Name "convert"] (Just $ Iden [Name "char_value"])-> [("using", Iden [Name "conversion_char_name"])])--> ,("TRANSLATE(char_value USING translation_name)"-> ,SpecialOpK [Name "translate"] (Just $ Iden [Name "char_value"])-> [("using", Iden [Name "translation_name"])])--OVERLAY(string PLACING embedded_string FROM start-[FOR length])--> ,("OVERLAY(string PLACING embedded_string FROM start)"-> ,SpecialOpK [Name "overlay"] (Just $ Iden [Name "string"])-> [("placing", Iden [Name "embedded_string"])-> ,("from", Iden [Name "start"])])--> ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"-> ,SpecialOpK [Name "overlay"] (Just $ Iden [Name "string"])-> [("placing", Iden [Name "embedded_string"])-> ,("from", Iden [Name "start"])-> ,("for", Iden [Name "length"])])--TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]-target_string-[COLLATE collation_name] )----> ,("trim(from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("both", StringLit " ")-> ,("from", Iden [Name "target_string"])])--> ,("trim(leading from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("leading", StringLit " ")-> ,("from", Iden [Name "target_string"])])--> ,("trim(trailing from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("trailing", StringLit " ")-> ,("from", Iden [Name "target_string"])])--> ,("trim(both from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("both", StringLit " ")-> ,("from", Iden [Name "target_string"])])---> ,("trim(leading 'x' from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("leading", StringLit "x")-> ,("from", Iden [Name "target_string"])])--> ,("trim(trailing 'y' from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("trailing", StringLit "y")-> ,("from", Iden [Name "target_string"])])--> ,("trim(both 'z' from target_string collate C)"-> ,SpecialOpK [Name "trim"] Nothing-> [("both", StringLit "z")-> ,("from", Collate (Iden [Name "target_string"]) [Name "C"])])--> ,("trim(leading from target_string)"-> ,SpecialOpK [Name "trim"] Nothing-> [("leading", StringLit " ")-> ,("from", Iden [Name "target_string"])])---> ]--> aggregates :: TestItem-> aggregates = Group "aggregates" $ map (uncurry (TestValueExpr SQL2011))-> [("count(*)",App [Name "count"] [Star])--> ,("sum(a order by a)"-> ,AggregateApp [Name "sum"] SQDefault [Iden [Name "a"]]-> [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(all a)"-> ,AggregateApp [Name "sum"] All [Iden [Name "a"]] [] Nothing)--> ,("count(distinct a)"-> ,AggregateApp [Name "count"] Distinct [Iden [Name "a"]] [] Nothing)-> ]--> windowFunctions :: TestItem-> windowFunctions = Group "windowFunctions" $ map (uncurry (TestValueExpr SQL2011))-> [("max(a) over ()", WindowApp [Name "max"] [Iden [Name "a"]] [] [] Nothing)-> ,("count(*) over ()", WindowApp [Name "count"] [Star] [] [] Nothing)--> ,("max(a) over (partition by b)"-> ,WindowApp [Name "max"] [Iden [Name "a"]] [Iden [Name "b"]] [] Nothing)--> ,("max(a) over (partition by b,c)"-> ,WindowApp [Name "max"] [Iden [Name "a"]] [Iden [Name "b"],Iden [Name "c"]] [] Nothing)--> ,("sum(a) over (order by b)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] []-> [SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(a) over (order by b desc,c)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] []-> [SortSpec (Iden [Name "b"]) Desc NullsOrderDefault-> ,SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(a) over (partition by b order by c)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] Nothing)--> ,("sum(a) over (partition by b order by c range unbounded preceding)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange UnboundedPreceding)--> ,("sum(a) over (partition by b order by c range 5 preceding)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))--> ,("sum(a) over (partition by b order by c range current row)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRange Current)--> ,("sum(a) over (partition by b order by c rows 5 following)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameFrom FrameRows $ Following (NumLit "5"))--> ,("sum(a) over (partition by b order by c range unbounded following)"-> ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "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 "sum"] [Iden [Name "a"]] [Iden [Name "b"]]-> [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault]-> $ Just $ FrameBetween FrameRange-> (Preceding (NumLit "5"))-> (Following (NumLit "5")))--> ]--> parens :: TestItem-> parens = Group "parens" $ map (uncurry (TestValueExpr SQL2011))-> [("(a)", Parens (Iden [Name "a"]))-> ,("(a + b)", Parens (BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"])))-> ]
− tools/RunTests.lhs
@@ -1,8 +0,0 @@---> import Test.Framework--> import Language.SQL.SimpleSQL.Tests--> main :: IO ()-> main = defaultMain [tests]
− tools/SQLIndent.lhs
@@ -1,17 +0,0 @@--> import System.Environment--> import Language.SQL.SimpleSQL.Pretty-> import Language.SQL.SimpleSQL.Parser-> import Language.SQL.SimpleSQL.Syntax--> main :: IO ()-> main = do-> args <- getArgs-> case args of-> [f] -> do-> src <- readFile f-> either (error . peFormattedError)-> (putStrLn . prettyQueryExprs SQL2011)-> $ parseQueryExprs SQL2011 f Nothing src-> _ -> error "please pass filename to indent"