packages feed

simple-sql-parser 0.4.4 → 0.5.0

raw patch · 36 files changed

+13851/−7183 lines, 36 filesdep +pretty-showdep +tastydep +tasty-hunitdep −HUnitdep −test-frameworkdep −test-framework-hunitnew-component:exe:Fixitynew-component:exe:SimpleSqlParserTool

Dependencies added: pretty-show, tasty, tasty-hunit

Dependencies removed: HUnit, test-framework, test-framework-hunit

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013, Jake Wheat+Copyright (c) 2013, 2014, 2015, Jake Wheat  All rights reserved.
Language/SQL/SimpleSQL/Combinators.lhs view
@@ -17,9 +17,8 @@  > import Control.Applicative ((<$>), (<*>), (<**>), pure, Applicative) > import Text.Parsec (option,many)-> import Text.Parsec.Prim (Parsec)+> import Text.Parsec.String (GenParser) -> 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@@ -29,7 +28,7 @@ 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 :: (a -> GenParser t s a) -> a -> GenParser t s a > optionSuffix p a = option a (p a)  @@ -39,7 +38,7 @@ 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+> (<??>) :: GenParser t s a -> GenParser t s (a -> a) -> GenParser t s a > p <??> q = p <**> option id q  @@ -80,7 +79,7 @@ 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)+> (<??.>) :: GenParser t s (a -> a) -> GenParser t s (a -> a) -> GenParser t s (a -> a) > (<??.>) pa pb = (.) `c` pa <*> option id pb >   -- todo: fix this mess >   where c = (<$>) . flip@@ -88,7 +87,7 @@  0 to many repeated applications of suffix parser -> (<??*>) :: Parser s a -> Parser s (a -> a) -> Parser s a+> (<??*>) :: GenParser t s a -> GenParser t s (a -> a) -> GenParser t s a > p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)
+ Language/SQL/SimpleSQL/Dialect.lhs view
@@ -0,0 +1,54 @@+++Data types to represent different dialect options++> {-# LANGUAGE DeriveDataTypeable #-}+> module Language.SQL.SimpleSQL.Dialect+>     (SyntaxFlavour(..)+>     ,Dialect(..)+>     ,ansi2011+>     ,mysql+>     ,postgres+>     ,oracle+>     ,sqlserver+>     ) where++> import Data.Data+++hack for now, later will expand to flags on a feature by feature basis++> data SyntaxFlavour = ANSI2011+>                    | MySQL+>                    | Postgres+>                    | Oracle+>                    | SQLServer+>                      deriving (Eq,Show,Read,Data,Typeable)++> -- | Used to set the dialect used for parsing and pretty printing,+> -- very unfinished at the moment.+> data Dialect = Dialect {diSyntaxFlavour :: SyntaxFlavour+>                        ,allowOdbc :: Bool}+>                deriving (Eq,Show,Read,Data,Typeable)++> -- | ansi sql 2011 dialect+> ansi2011 :: Dialect+> ansi2011 = Dialect ANSI2011 False++> -- | mysql dialect+> mysql :: Dialect+> mysql = Dialect MySQL False++> -- | postgresql dialect+> postgres :: Dialect+> postgres = Dialect Postgres False++> -- | oracle dialect+> oracle :: Dialect+> oracle = Dialect Oracle False++> -- | microsoft sql server dialect+> sqlserver :: Dialect+> sqlserver = Dialect SQLServer False++
+ Language/SQL/SimpleSQL/Lex.lhs view
@@ -0,0 +1,717 @@++The parser uses a separate lexer for two reasons:++1. sql syntax is very awkward to parse, the separate lexer makes it+easier to handle this in most places (in some places it makes it+harder or impossible, the fix is to switch to something better than+parsec)++2. using a separate lexer gives a huge speed boost because it reduces+backtracking. (We could get this by making the parsing code a lot more+complex also.)++3. we can test the lexer relatively exhaustively, then even when we+don't do nearly as comprehensive testing on the syntax level, we still+have a relatively high assurance of the low level of bugs. This is+much more difficult to get parity with when testing the syntax parser+directly without the separately testing lexing stage.++> -- | Lexer for SQL.+> {-# LANGUAGE TupleSections #-}+> module Language.SQL.SimpleSQL.Lex+>     (Token(..)+>     ,lexSQL+>     ,prettyToken+>     ,prettyTokens+>     ,ParseError(..)+>     ,Dialect(..)+>     ,tokenListWillPrintAndLex+>     ) where++> import Language.SQL.SimpleSQL.Dialect++> import Text.Parsec (option,string,manyTill,anyChar+>                    ,try,string,many1,oneOf,digit,(<|>),choice,char,eof+>                    ,many,runParser,lookAhead,satisfy+>                    ,setPosition,getPosition+>                    ,setSourceColumn,setSourceLine+>                    ,sourceName, setSourceName+>                    ,sourceLine, sourceColumn+>                    ,notFollowedBy)+> import Language.SQL.SimpleSQL.Combinators+> import Language.SQL.SimpleSQL.Errors+> import Control.Applicative hiding ((<|>), many)+> import Data.Char+> import Control.Monad+> import Prelude hiding (takeWhile)+> import Text.Parsec.String (Parser)+> import Data.Maybe+++> -- | Represents a lexed token+> data Token+>     -- | A symbol (in ansi dialect) is one of the following+>     --+>     -- * multi char symbols <> \<= \>= != ||+>     -- * single char symbols: * + -  < >  ^ / %  ~ & | ? ( ) [ ] , ; ( )+>     --+>     = Symbol String+>+>     -- | This is an identifier or keyword. The first field is+>     -- the quotes used, or nothing if no quotes were used. The quotes+>     -- can be " or u& or something dialect specific like []+>     | Identifier (Maybe (String,String)) String+>+>     -- | This is a prefixed variable symbol, such as :var, @var or #var+>     -- (only :var is used in ansi dialect)+>     | PrefixedVariable Char String+>+>     -- | This is a positional arg identifier e.g. $1+>     | PositionalArg Int+>+>     -- | This is a string literal. The first two fields are the --+>     -- start and end quotes, which are usually both ', but can be+>     -- the character set (one of nNbBxX, or u&, U&), or a dialect+>     -- specific string quoting (such as $$ in postgres)+>     | SqlString String String String+>+>     -- | A number literal (integral or otherwise), stored in original format+>     -- unchanged+>     | SqlNumber String+>+>     -- | Whitespace, one or more of space, tab or newline.+>     | Whitespace String+>+>     -- | A commented line using --, contains every character starting with the+>     -- \'--\' and including the terminating newline character if there is one+>     -- - this will be missing if the last line in the source is a line comment+>     -- with no trailing newline+>     | LineComment String+>+>     -- | A block comment, \/* stuff *\/, includes the comment delimiters+>     | BlockComment String+>+>       deriving (Eq,Show)++++> -- | Pretty printing, if you lex a bunch of tokens, then pretty+> -- print them, should should get back exactly the same string+> prettyToken :: Dialect -> Token -> String+> prettyToken _ (Symbol s) = s+> prettyToken _ (Identifier Nothing t) = t+> prettyToken _ (Identifier (Just (q1,q2)) t) = q1 ++ t ++ q2+> prettyToken _ (PrefixedVariable c p) = c:p+> prettyToken _ (PositionalArg p) = '$':show p+> prettyToken _ (SqlString s e t) = s ++ t ++ e+> prettyToken _ (SqlNumber r) = r+> prettyToken _ (Whitespace t) = t+> prettyToken _ (LineComment l) = l+> prettyToken _ (BlockComment c) = c++> prettyTokens :: Dialect -> [Token] -> String+> prettyTokens d ts = concat $ map (prettyToken d) ts++TODO: try to make all parsers applicative only++> -- | Lex some SQL to a list of tokens.+> lexSQL :: Dialect+>                   -- ^ dialect of SQL to use+>                -> FilePath+>                   -- ^ filename to use in error messages+>                -> Maybe (Int,Int)+>                   -- ^ line number and column number of the first character+>                   -- in the source to use in error messages+>                -> String+>                   -- ^ the SQL source to lex+>                -> Either ParseError [((String,Int,Int),Token)]+> lexSQL dialect fn' p src =+>     let (l',c') = fromMaybe (1,1) p+>     in either (Left . convParseError src) Right+>        $ runParser (setPos (fn',l',c') *> many (sqlToken dialect) <* eof) () fn' src+>   where+>     setPos (fn,l,c) = do+>         fmap (flip setSourceName fn+>                . flip setSourceLine l+>                . flip setSourceColumn c) getPosition+>           >>= setPosition++> -- | parser for a sql token+> sqlToken :: Dialect -> Parser ((String,Int,Int),Token)+> sqlToken d = do+>     p' <- getPosition+>     let p = (sourceName p',sourceLine p', sourceColumn p')++The order of parsers is important: strings and quoted identifiers can+start out looking like normal identifiers, so we try to parse these+first and use a little bit of try. Line and block comments start like+symbols, so we try these before symbol. Numbers can start with a . so+this is also tried before symbol (a .1 will be parsed as a number, but+. otherwise will be parsed as a symbol).++>     (p,) <$> choice [sqlString d+>                     ,identifier d+>                     ,lineComment d+>                     ,blockComment d+>                     ,sqlNumber d+>                     ,positionalArg d+>                     ,dontParseEndBlockComment d+>                     ,prefixedVariable d+>                     ,symbol d+>                     ,sqlWhitespace d]++Parses identifiers:++simple_identifier_23+u&"unicode quoted identifier"+"quoted identifier"+"quoted identifier "" with double quote char"+`mysql quoted identifier`++> identifier :: Dialect -> Parser Token+> identifier d =+>     choice+>     [quotedIden+>     ,unicodeQuotedIden+>     ,regularIden+>     ,guard (diSyntaxFlavour d == MySQL) >> mySqlQuotedIden+>     ,guard (diSyntaxFlavour d == SQLServer) >> sqlServerQuotedIden+>     ]+>   where+>     regularIden = Identifier Nothing <$> identifierString+>     quotedIden = Identifier (Just ("\"","\"")) <$> qidenPart+>     mySqlQuotedIden = Identifier (Just ("`","`"))+>                       <$> (char '`' *> takeWhile1 (/='`') <* char '`')+>     sqlServerQuotedIden = Identifier (Just ("[","]"))+>                           <$> (char '[' *> takeWhile1 (`notElem` "[]") <* char ']')+>     -- try is used here to avoid a conflict with identifiers+>     -- and quoted strings which also start with a 'u'+>     unicodeQuotedIden = Identifier+>                         <$> (f <$> try (oneOf "uU" <* string "&"))+>                         <*> qidenPart+>       where f x = Just (x: "&\"", "\"")+>     qidenPart = char '"' *> qidenSuffix ""+>     qidenSuffix t = do+>         s <- takeTill (=='"')+>         void $ char '"'+>         -- deal with "" as literal double quote character+>         choice [do+>                 void $ char '"'+>                 qidenSuffix $ concat [t,s,"\"\""]+>                ,return $ concat [t,s]]+++This parses a valid identifier without quotes.++> identifierString :: Parser String+> identifierString =+>     startsWith (\c -> c == '_' || isAlpha c) isIdentifierChar++this can be moved to the dialect at some point++> isIdentifierChar :: Char -> Bool+> isIdentifierChar c = c == '_' || isAlphaNum c++use try because : and @ can be part of other things also++> prefixedVariable :: Dialect -> Parser Token+> prefixedVariable  d = try $ choice+>     [PrefixedVariable <$> char ':' <*> identifierString+>     ,guard (diSyntaxFlavour d == SQLServer) >>+>      PrefixedVariable <$> char '@' <*> identifierString+>     ,guard (diSyntaxFlavour d == SQLServer) >>+>      PrefixedVariable <$> char '#' <*> identifierString+>     ]++> positionalArg :: Dialect -> Parser Token+> positionalArg d =+>   guard (diSyntaxFlavour d == Postgres) >>+>   -- use try to avoid ambiguities with other syntax which starts with dollar+>   PositionalArg <$> try (char '$' *> (read <$> many1 digit))+++Parse a SQL string. Examples:++'basic string'+'string with '' a quote'+n'international text'+b'binary string'+x'hexidecimal string'+++> sqlString :: Dialect -> Parser Token+> sqlString d = dollarString <|> csString <|> normalString+>   where+>     dollarString = do+>         guard $ diSyntaxFlavour d == Postgres+>         -- use try because of ambiguity with symbols and with+>         -- positional arg+>         delim <- (\x -> concat ["$",x,"$"])+>                  <$> try (char '$' *> option "" identifierString <* char '$')+>         SqlString delim delim  <$> manyTill anyChar (try $ string delim)+>     normalString = SqlString "'" "'" <$> (char '\'' *> normalStringSuffix False "")+>     normalStringSuffix allowBackslash t = do+>         s <- takeTill $ if allowBackslash+>                         then (`elem` "'\\")+>                         else (== '\'')+>         -- deal with '' or \' as literal quote character+>         choice [do+>                 ctu <- choice ["''" <$ try (string "''")+>                               ,"\\'" <$ string "\\'"+>                               ,"\\" <$ char '\\']+>                 normalStringSuffix allowBackslash $ concat [t,s,ctu]+>                ,concat [t,s] <$ char '\'']+>     -- try is used to to avoid conflicts with+>     -- identifiers which can start with n,b,x,u+>     -- once we read the quote type and the starting '+>     -- then we commit to a string+>     -- it's possible that this will reject some valid syntax+>     -- but only pathalogical stuff, and I think the improved+>     -- error messages and user predictability make it a good+>     -- pragmatic choice+>     csString+>       | diSyntaxFlavour d == Postgres =+>         choice [SqlString <$> try (string "e'" <|> string "E'")+>                           <*> return "'" <*> normalStringSuffix True ""+>                ,csString']+>       | otherwise = csString'+>     csString' = SqlString+>                 <$> try cs+>                 <*> return "'"+>                 <*> normalStringSuffix False ""+>     csPrefixes = "nNbBxX"+>     cs = choice $ (map (\x -> string ([x] ++ "'")) csPrefixes)+>                   ++ [string "u&'"+>                      ,string "U&'"]++numbers++digits+digits.[digits][e[+-]digits]+[digits].digits[e[+-]digits]+digitse[+-]digits++where digits is one or more decimal digits (0 through 9). At least one+digit must be before or after the decimal point, if one is used. At+least one digit must follow the exponent marker (e), if one is+present. There cannot be any spaces or other characters embedded in+the constant. Note that any leading plus or minus sign is not actually+considered part of the constant; it is an operator applied to the+constant.++> sqlNumber :: Dialect -> Parser Token+> sqlNumber d =+>     SqlNumber <$> completeNumber+>     -- this is for definitely avoiding possibly ambiguous source+>     <* choice [-- special case to allow e.g. 1..2+>                guard (diSyntaxFlavour d == Postgres)+>                *> (void $ lookAhead $ try $ string "..")+>                   <|> void (notFollowedBy (oneOf "eE."))+>               ,notFollowedBy (oneOf "eE.")+>               ]+>   where+>     completeNumber =+>       (int <??> (pp dot <??.> pp int)+>       -- try is used in case we read a dot+>       -- and it isn't part of a number+>       -- if there are any following digits, then we commit+>       -- to it being a number and not something else+>       <|> try ((++) <$> dot <*> int))+>       <??> pp expon++>     int = many1 digit+>     -- make sure we don't parse two adjacent dots in a number+>     -- special case for postgresql, we backtrack if we see two adjacent dots+>     -- to parse 1..2, but in other dialects we commit to the failure+>     dot = let p = string "." <* notFollowedBy (char '.')+>           in if (diSyntaxFlavour d == Postgres)+>              then try p+>              else p+>     expon = (:) <$> oneOf "eE" <*> sInt+>     sInt = (++) <$> option "" (string "+" <|> string "-") <*> int+>     pp = (<$$> (++))++Symbols++A symbol is an operator, or one of the misc symbols which include:+. .. := : :: ( ) ? ; , { } (for odbc)++The postgresql operator syntax allows a huge range of operators+compared with ansi and other dialects++> symbol :: Dialect -> Parser Token+> symbol d  = Symbol <$> choice (concat+>    [dots+>    ,if (diSyntaxFlavour d == Postgres)+>     then postgresExtraSymbols+>     else []+>    ,miscSymbol+>    ,if allowOdbc d then odbcSymbol else []+>    ,if (diSyntaxFlavour d == Postgres)+>     then generalizedPostgresqlOperator+>     else basicAnsiOps+>    ])+>  where+>    dots = [many1 (char '.')]+>    odbcSymbol = [string "{", string "}"]+>    postgresExtraSymbols =+>        [try (string ":=")+>         -- parse :: and : and avoid allowing ::: or more+>        ,try (string "::" <* notFollowedBy (char ':'))+>        ,try (string ":" <* notFollowedBy (char ':'))]+>    miscSymbol = map (string . (:[])) $+>        case diSyntaxFlavour d of+>            SQLServer -> ",;():?"+>            Postgres -> "[],;()"+>            _ -> "[],;():?"++try is used because most of the first characters of the two character+symbols can also be part of a single character symbol++>    basicAnsiOps = map (try . string) [">=","<=","!=","<>"]+>                   ++ map (string . (:[])) "+-^*/%~&<>="+>                   ++ pipes+>    pipes = -- what about using many1 (char '|'), then it will+>            -- fail in the parser? Not sure exactly how+>            -- standalone the lexer should be+>            [char '|' *>+>             choice ["||" <$ char '|' <* notFollowedBy (char '|')+>                    ,return "|"]]++postgresql generalized operators++this includes the custom operators that postgres supports,+plus all the standard operators which could be custom operators+according to their grammar++rules++An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:+++ - * / < > = ~ ! @ # % ^ & | ` ?++There are a few restrictions on operator names, however:+-- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.++A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:++~ ! @ # % ^ & | ` ?++which allows the last character of a multi character symbol to be + or+-++> generalizedPostgresqlOperator :: [Parser String]+> generalizedPostgresqlOperator = [singlePlusMinus,opMoreChars]+>   where+>     allOpSymbols = "+-*/<>=~!@#%^&|`?"+>     -- these are the symbols when if part of a multi character+>     -- operator permit the operator to end with a + or - symbol+>     exceptionOpSymbols = "~!@#%^&|`?"++>     -- special case for parsing a single + or - symbol+>     singlePlusMinus = try $ do+>       c <- oneOf "+-"+>       notFollowedBy $ oneOf allOpSymbols+>       return [c]++>     -- this is used when we are parsing a potentially multi symbol+>     -- operator and we have alread seen one of the 'exception chars'+>     -- and so we can end with a + or -+>     moreOpCharsException = do+>        c <- oneOf (filter (`notElem` "-/*") allOpSymbols)+>             -- make sure we don't parse a comment starting token+>             -- as part of an operator+>             <|> try (char '/' <* notFollowedBy (char '*'))+>             <|> try (char '-' <* notFollowedBy (char '-'))+>             -- and make sure we don't parse a block comment end+>             -- as part of another symbol+>             <|> try (char '*' <* notFollowedBy (char '/'))+>        (c:) <$> option [] moreOpCharsException++>     opMoreChars = choice+>        [-- parse an exception char, now we can finish with a + -+>         (:)+>         <$> oneOf exceptionOpSymbols+>         <*> option [] moreOpCharsException+>        ,(:)+>         <$> (-- parse +, make sure it isn't the last symbol+>              try (char '+' <* lookAhead (oneOf allOpSymbols))+>              <|> -- parse -, make sure it isn't the last symbol+>                  -- or the start of a -- comment+>              try (char '-'+>                   <* notFollowedBy (char '-')+>                   <* lookAhead (oneOf allOpSymbols))+>              <|> -- parse / check it isn't the start of a /* comment+>              try (char '/' <* notFollowedBy (char '*'))+>              <|> -- make sure we don't parse */ as part of a symbol+>              try (char '*' <* notFollowedBy (char '/'))+>              <|> -- any other ansi operator symbol+>              oneOf "<>=")+>         <*> option [] opMoreChars+>        ]++> sqlWhitespace :: Dialect -> Parser Token+> sqlWhitespace _ = Whitespace <$> many1 (satisfy isSpace)++> lineComment :: Dialect -> Parser Token+> lineComment _ =+>     (\s -> LineComment $ concat ["--",s]) <$>+>     -- try is used here in case we see a - symbol+>     -- once we read two -- then we commit to the comment token+>     (try (string "--") *> (+>         -- todo: there must be a better way to do this+>      conc <$> manyTill anyChar (lookAhead lineCommentEnd) <*> lineCommentEnd))+>   where+>     conc a Nothing = a+>     conc a (Just b) = a ++ b+>     lineCommentEnd =+>         Just "\n" <$ char '\n'+>         <|> Nothing <$ eof++Try is used in the block comment for the two symbol bits because we+want to backtrack if we read the first symbol but the second symbol+isn't there.++> blockComment :: Dialect -> Parser Token+> blockComment _ =+>     (\s -> BlockComment $ concat ["/*",s]) <$>+>     (try (string "/*") *> commentSuffix 0)+>   where+>     commentSuffix :: Int -> Parser String+>     commentSuffix n = do+>       -- read until a possible end comment or nested comment+>       x <- takeWhile (\e -> e /= '/' && e /= '*')+>       choice [-- close comment: if the nesting is 0, done+>               -- otherwise recurse on commentSuffix+>               try (string "*/") *> let t = concat [x,"*/"]+>                                    in if n == 0+>                                       then return t+>                                       else (\s -> concat [t,s]) <$> commentSuffix (n - 1)+>               -- nested comment, recurse+>              ,try (string "/*") *> ((\s -> concat [x,"/*",s]) <$> commentSuffix (n + 1))+>               -- not an end comment or nested comment, continue+>              ,(\c s -> x ++ [c] ++ s) <$> anyChar <*> commentSuffix n]+++This is to improve user experience: provide an error if we see */+outside a comment. This could potentially break postgres ops with */+in them (which is a stupid thing to do). In other cases, the user+should write * / instead (I can't think of any cases when this would+be valid syntax though).++> dontParseEndBlockComment :: Dialect -> Parser Token+> dontParseEndBlockComment _ =+>     -- don't use try, then it should commit to the error+>     try (string "*/") *> fail "comment end without comment start"+++Some helper combinators++> startsWith :: (Char -> Bool) -> (Char -> Bool) -> Parser String+> startsWith p ps = do+>   c <- satisfy p+>   choice [(:) c <$> (takeWhile1 ps)+>          ,return [c]]++> takeWhile1 :: (Char -> Bool) -> Parser String+> takeWhile1 p = many1 (satisfy p)++> takeWhile :: (Char -> Bool) -> Parser String+> takeWhile p = many (satisfy p)++> takeTill :: (Char -> Bool) -> Parser String+> takeTill p = manyTill anyChar (peekSatisfy p)++> peekSatisfy :: (Char -> Bool) -> Parser ()+> peekSatisfy p = void $ lookAhead (satisfy p)++This utility function will accurately report if the two tokens are+pretty printed, if they should lex back to the same two tokens. This+function is used in testing (and can be used in other places), and+must not be implemented by actually trying to print both tokens and+then lex them back from a single string (because then we would have+the risk of thinking two tokens cannot be together when there is bug+in the lexer, which the testing is supposed to find).++maybe do some quick checking to make sure this function only gives+true negatives: check pairs which return false actually fail to lex or+give different symbols in return: could use quickcheck for this++a good sanity test for this function is to change it to always return+true, then check that the automated tests return the same number of+successes. I don't think it succeeds this test at the moment++> -- | Utility function to tell you if a list of tokens+> -- will pretty print then lex back to the same set of tokens.+> -- Used internally, might be useful for generating SQL via lexical tokens.+> tokenListWillPrintAndLex :: Dialect -> [Token] -> Bool+> tokenListWillPrintAndLex _ [] = True+> tokenListWillPrintAndLex _ [_] = True+> tokenListWillPrintAndLex d (a:b:xs) =+>     tokensWillPrintAndLex d a b && tokenListWillPrintAndLex d (b:xs)++> tokensWillPrintAndLex :: Dialect -> Token -> Token -> Bool+> tokensWillPrintAndLex d a b++a : followed by an identifier character will look like a host param+followed by = or : makes a different symbol++>     | Symbol ":" <- a+>     , checkFirstBChar (\x -> isIdentifierChar x || x `elem` ":=") = False++two symbols next to eachother will fail if the symbols can combine and+(possibly just the prefix) look like a different symbol++>     | Dialect {diSyntaxFlavour = Postgres} <- d+>     , Symbol a' <- a+>     , Symbol b' <- b+>     , b' `notElem` ["+", "-"] || or (map (`elem` a') "~!@#%^&|`?") = False++check two adjacent symbols in non postgres where the combination+possibilities are much more limited. This is ansi behaviour, it might+be different when the other dialects are done properly++>    | Symbol a' <- a+>    , Symbol b' <- b+>    , (a',b') `elem` [("<",">")+>                     ,("<","=")+>                     ,(">","=")+>                     ,("!","=")+>                     ,("|","|")+>                     ,("||","|")+>                     ,("|","||")+>                     ,("||","||")+>                     ,("<",">=")+>                     ] = False++two whitespaces will be combined++>    | Whitespace {} <- a+>    , Whitespace {} <- b = False++line comment without a newline at the end will eat the next token++>    | LineComment {} <- a+>    , checkLastAChar (/='\n') = False++check the last character of the first token and the first character of+the second token forming a comment start or end symbol++>    | let f '-' '-' = True+>          f '/' '*' = True+>          f '*' '/' = True+>          f _ _ = False+>      in checkBorderChars f = False++a symbol will absorb a following .+TODO: not 100% on this always being bad++>    | Symbol {} <- a+>    , checkFirstBChar (=='.') = False++cannot follow a symbol ending in : with another token starting with :++>    | let f ':' ':' = True+>          f _ _ = False+>      in checkBorderChars f = False++unquoted identifier followed by an identifier letter++>    | Identifier Nothing _ <- a+>    , checkFirstBChar isIdentifierChar = False++a quoted identifier using ", followed by a " will fail++>    | Identifier (Just (_,"\"")) _ <- a+>    , checkFirstBChar (=='"') = False++prefixed variable followed by an identifier char will be absorbed++>    | PrefixedVariable {} <- a+>    , checkFirstBChar isIdentifierChar = False++a positional arg will absorb a following digit++>    | PositionalArg {} <- a+>    , checkFirstBChar isDigit = False++a string ending with ' followed by a token starting with ' will be absorbed++>    | SqlString _ "'" _ <- a+>    , checkFirstBChar (=='\'') = False++a number followed by a . will fail or be absorbed++>    | SqlNumber {} <- a+>    , checkFirstBChar (=='.') = False++a number followed by an e or E will fail or be absorbed++>    | SqlNumber {} <- a+>    , checkFirstBChar (\x -> x =='e' || x == 'E') = False++two numbers next to eachother will fail or be absorbed++>    | SqlNumber {} <- a+>    , SqlNumber {} <- b = False+++>    | otherwise = True++>   where+>     prettya = prettyToken d a+>     prettyb = prettyToken d b+>     -- helper function to run a predicate on the+>     -- last character of the first token and the first+>     -- character of the second token+>     checkBorderChars f+>         | (_:_) <- prettya+>         , (fb:_) <- prettyb+>         , la <- last prettya+>         = f la fb+>     checkBorderChars _ = False+>     checkFirstBChar f = case prettyb of+>                           (b':_) -> f b'+>                           _ -> False+>     checkLastAChar f = case prettya of+>                           (_:_) -> f $ last prettya+>                           _ -> False+++++TODO:++make the tokenswill print more dialect accurate. Maybe add symbol+  chars and identifier chars to the dialect definition and use them from+  here++start adding negative / different parse dialect tests++add token tables and tests for oracle, sql server+review existing tables++look for refactoring opportunities, especially the token+generation tables in the tests++do some user documentation on lexing, and lexing/dialects++start thinking about a more separated design for the dialect handling++lexing tests are starting to take a really long time, so split the+tests so it is much easier to run all the tests except the lexing+tests which only need to be run when working on the lexer (which+should be relatively uncommon), or doing a commit or finishing off a+series of commits,++start writing the error message tests:+  generate/write a large number of syntax errors+  create a table with the source and the error message+  try to compare some different versions of code to compare the+    quality of the error messages by hand++  get this checked in so improvements and regressions in the error+    message quality can be tracked a little more easily (although it will+    still be manual)++try again to add annotation to the ast
+ Language/SQL/SimpleSQL/Parse.lhs view
@@ -0,0 +1,2579 @@++= TOC:++notes+Public api+Names - parsing identifiers+Typenames+Scalar expressions+  simple literals+  star, param+  parens expression, row constructor and scalar subquery+  case, cast, exists, unique, array/ multiset constructor+  typed literal, app, special function, aggregate, window function+  suffixes: in, between, quantified comparison, match predicate, array+    subscript, escape, collate+  operators+  scalar expression top level+  helpers+query expressions+  select lists+  from clause+  other table expression clauses:+    where, group by, having, order by, offset and fetch+  common table expressions+  query expression+  set operations+lexers+utilities++= Notes about the code++The lexers appear at the bottom of the file. There tries to be a clear+separation between the lexers and the other parser which only use the+lexers, this isn't 100% complete at the moment and needs fixing.++== Left factoring++The parsing code is aggressively left factored, and try is avoided as+much as possible. Try is avoided because:++ * when it is overused it makes the code hard to follow+ * when it is overused it makes the parsing code harder to debug+ * it makes the parser error messages much worse++The code could be made a bit simpler with a few extra 'trys', but this+isn't done because of the impact on the parser error+messages. Apparently it can also help the speed but this hasn't been+looked into.++== Parser error messages++A lot of care has been given to generating good parser error messages+for invalid syntax. There are a few utils below which partially help+in this area.++There is a set of crafted bad expressions in ErrorMessages.lhs, these+are used to guage the quality of the error messages and monitor+regressions by hand. The use of <?> is limited as much as possible:+each instance should justify itself by improving an actual error+message.++There is also a plan to write a really simple expression parser which+doesn't do precedence and associativity, and the fix these with a pass+over the ast. I don't think there is any other way to sanely handle+the common prefixes between many infix and postfix multiple keyword+operators, and some other ambiguities also. This should help a lot in+generating good error messages also.++Both the left factoring and error message work are greatly complicated+by the large number of shared prefixes of the various elements in SQL+syntax.++== Main left factoring issues++There are three big areas which are tricky to left factor:++ * typenames+ * scalar expressions which can start with an identifier+ * infix and suffix operators++=== typenames++There are a number of variations of typename syntax. The standard+deals with this by switching on the name of the type which is parsed+first. This code doesn't do this currently, but might in the+future. Taking the approach in the standard grammar will limit the+extensibility of the parser and might affect the ease of adapting to+support other sql dialects.++=== identifier scalar expressions++There are a lot of scalar expression nodes which start with+identifiers, and can't be distinguished the tokens after the initial+identifier are parsed. Using try to implement these variations is very+simple but makes the code much harder to debug and makes the parser+error messages really bad.++Here is a list of these nodes:++ * identifiers+ * function application+ * aggregate application+ * window application+ * typed literal: typename 'literal string'+ * interval literal which is like the typed literal with some extras++There is further ambiguity e.g. with typed literals with precision,+functions, aggregates, etc. - these are an identifier, followed by+parens comma separated scalar expressions or something similar, and it+is only later that we can find a token which tells us which flavour it+is.++There is also a set of nodes which start with an identifier/keyword+but can commit since no other syntax can start the same way:++ * case+ * cast+ * exists, unique subquery+ * array constructor+ * multiset constructor+ * all the special syntax functions: extract, position, substring,+  convert, translate, overlay, trim, etc.++The interval literal mentioned above is treated in this group at the+moment: if we see 'interval' we parse it either as a full interval+literal or a typed literal only.++Some items in this list might have to be fixed in the future, e.g. to+support standard 'substring(a from 3 for 5)' as well as regular+function substring syntax 'substring(a,3,5) at the same time.++The work in left factoring all this is mostly done, but there is still+a substantial bit to complete and this is by far the most difficult+bit. At the moment, the work around is to use try, the downsides of+which is the poor parsing error messages.++=== infix and suffix operators++== permissiveness++The parser is very permissive in many ways. This departs from the+standard which is able to eliminate a number of possibilities just in+the grammar, which this parser allows. This is done for a number of+reasons:++ * it makes the parser simple - less variations+ * it should allow for dialects and extensibility more easily in the+  future (e.g. new infix binary operators with custom precedence)+ * many things which are effectively checked in the grammar in the+  standard, can be checked using a typechecker or other simple static+  analysis++To use this code as a front end for a sql engine, or as a sql validity+checker, you will need to do a lot of checks on the ast. A+typechecker/static checker plus annotation to support being a compiler+front end is planned but not likely to happen too soon.++Some of the areas this affects:++typenames: the variation of the type name should switch on the actual+name given according to the standard, but this code only does this for+the special case of interval type names. E.g. you can write 'int+collate C' or 'int(15,2)' and this will parse as a character type name+or a precision scale type name instead of being rejected.++scalar expressions: every variation on scalar expressions uses the same+parser/syntax. This means we don't try to stop non boolean valued+expressions in boolean valued contexts in the parser. Another area+this affects is that we allow general scalar expressions in group by,+whereas the standard only allows column names with optional collation.++These are all areas which are specified (roughly speaking) in the+syntax rather than the semantics in the standard, and we are not+fixing them in the syntax but leaving them till the semantic checking+(which doesn't exist in this code at this time).++> {-# LANGUAGE TupleSections #-}+> -- | This is the module with the parser functions.+> module Language.SQL.SimpleSQL.Parse+>     (parseQueryExpr+>     ,parseScalarExpr+>     ,parseStatement+>     ,parseStatements+>     ,ParseError(..)) where++> import Control.Monad.Identity (Identity)+> import Control.Monad (guard, void)+> import Control.Applicative ((<$), (<$>), (<*>) ,(<*), (*>), (<**>), pure)+> import Data.Char (toLower, isDigit)+> import Text.Parsec (setPosition,setSourceColumn,setSourceLine,getPosition+>                    ,option,between,sepBy,sepBy1+>                    ,try,many,many1,(<|>),choice,eof+>                    ,optionMaybe,optional,runParser+>                    ,chainl1, chainr1,(<?>))+> -- import Text.Parsec.String (Parser)+> import Text.Parsec.Perm (permute,(<$?>), (<|?>))+> import Text.Parsec.Prim (getState, token)+> import Text.Parsec.Pos (newPos)+> import qualified Text.Parsec.Expr as E+> import Data.List (intercalate,sort,groupBy)+> import Data.Function (on)+> import Language.SQL.SimpleSQL.Syntax+> import Language.SQL.SimpleSQL.Combinators+> import Language.SQL.SimpleSQL.Errors+> import Language.SQL.SimpleSQL.Dialect+> import qualified Language.SQL.SimpleSQL.Lex as L+> import Data.Maybe+> import Text.Parsec.String (GenParser)++= Public API++> -- | Parses a query expr, trailing semicolon optional.+> parseQueryExpr :: Dialect+>                   -- ^ dialect of SQL to use+>                -> FilePath+>                   -- ^ filename to use in error messages+>                -> Maybe (Int,Int)+>                   -- ^ line number and column number of the first character+>                   -- in the source to use in error messages+>                -> String+>                   -- ^ the SQL source to parse+>                -> Either ParseError QueryExpr+> parseQueryExpr = wrapParse topLevelQueryExpr++> -- | Parses a statement, trailing semicolon optional.+> parseStatement :: Dialect+>                   -- ^ dialect of SQL to use+>                -> FilePath+>                   -- ^ filename to use in error messages+>                -> Maybe (Int,Int)+>                   -- ^ line number and column number of the first character+>                   -- in the source to use in error messages+>                -> String+>                   -- ^ the SQL source to parse+>                -> Either ParseError Statement+> parseStatement = wrapParse topLevelStatement+++> -- | Parses a list of statements, with semi colons between+> -- them. The final semicolon is optional.+> parseStatements :: Dialect+>                   -- ^ dialect of SQL to use+>                 -> FilePath+>                    -- ^ filename to use in error messages+>                 -> Maybe (Int,Int)+>                    -- ^ line number and column number of the first character+>                    -- in the source to use in error messages+>                 -> String+>                    -- ^ the SQL source to parse+>                 -> Either ParseError [Statement]+> parseStatements = wrapParse statements++> -- | Parses a scalar expression.+> parseScalarExpr :: Dialect+>                    -- ^ dialect of SQL to use+>                 -> FilePath+>                    -- ^ filename to use in error messages+>                 -> Maybe (Int,Int)+>                    -- ^ line number and column number of the first character+>                    -- in the source to use in error messages+>                 -> String+>                    -- ^ the SQL source to parse+>                 -> Either ParseError ScalarExpr+> parseScalarExpr = wrapParse scalarExpr++This helper function takes the parser given and:++sets the position when parsing+automatically skips leading whitespace+checks the parser parses all the input using eof+converts the error return to the nice wrapper++> wrapParse :: Parser a+>           -> Dialect+>           -> FilePath+>           -> Maybe (Int,Int)+>           -> String+>           -> Either ParseError a+> wrapParse parser d f p src = do+>     let (l,c) = fromMaybe (1,1) p+>     lx <- L.lexSQL d f (Just (l,c)) src+>     either (Left . convParseError src) Right+>       $ runParser (setPos p *> parser <* eof)+>                   d f $ filter keep lx+>   where+>     setPos Nothing = pure ()+>     setPos (Just (l,c)) = fmap up getPosition >>= setPosition+>       where up = flip setSourceColumn c . flip setSourceLine l+>     keep (_,L.Whitespace {}) = False+>     keep (_,L.LineComment {}) = False+>     keep (_,L.BlockComment {}) = False+>     keep _ = True+++------------------------------------------------++= Names++Names represent identifiers and a few other things. The parser here+handles regular identifiers, dotten chain identifiers, quoted+identifiers and unicode quoted identifiers.++Dots: dots in identifier chains are parsed here and represented in the+Iden constructor usually. If parts of the chains are non identifier+scalar expressions, then this is represented by a BinOp "."+instead. Dotten chain identifiers which appear in other contexts (such+as function names, table names, are represented as [Name] only.++Identifier grammar:++unquoted:+underscore <|> letter : many (underscore <|> alphanum++example+_example123++quoted:++double quote, many (non quote character or two double quotes+together), double quote++"example quoted"+"example with "" quote"++unicode quoted is the same as quoted in this parser, except it starts+with U& or u&++u&"example quoted"++> name :: Parser Name+> name = do+>     d <- getState+>     uncurry Name <$> identifierTok (blacklist d)++todo: replace (:[]) with a named function all over++> names :: Parser [Name]+> names = reverse <$> (((:[]) <$> name) <??*> anotherName)+>   -- can't use a simple chain here since we+>   -- want to wrap the . + name in a try+>   -- this will change when this is left factored+>   where+>     anotherName :: Parser ([Name] -> [Name])+>     anotherName = try ((:) <$> (symbol "." *> name))++= Type Names++Typenames are used in casts, and also in the typed literal syntax,+which is a typename followed by a string literal.++Here are the grammar notes:++== simple type name++just an identifier chain or a multi word identifier (this is a fixed+list of possibilities, e.g. as 'character varying', see below in the+parser code for the exact list).++<simple-type-name> ::= <identifier-chain>+     | multiword-type-identifier++== Precision type name++<precision-type-name> ::= <simple-type-name> <left paren> <unsigned-int> <right paren>++e.g. char(5)++note: above and below every where a simple type name can appear, this+means a single identifier/quoted or a dotted chain, or a multi word+identifier++== Precision scale type name++<precision-type-name> ::= <simple-type-name> <left paren> <unsigned-int> <comma> <unsigned-int> <right paren>++e.g. decimal(15,2)++== Lob type name++this is a variation on the precision type name with some extra info on+the units:++<lob-type-name> ::=+   <simple-type-name> <left paren> <unsigned integer> [ <multiplier> ] [ <char length units> ] <right paren>++<multiplier>    ::=   K | M | G+<char length units>    ::=   CHARACTERS | CODE_UNITS | OCTETS++(if both multiplier and char length units are missing, then this will+parse as a precision type name)++e.g.+clob(5M octets)++== char type name++this is a simple type with optional precision which allows the+character set or the collation to appear as a suffix:++<char type name> ::=+    <simple type name>+    [ <left paren> <unsigned-int> <right paren> ]+    [ CHARACTER SET <identifier chain> ]+    [ COLLATE <identifier chain> ]++e.g.++char(5) character set my_charset collate my_collation++= Time typename++this is typename with optional precision and either 'with time zone'+or 'without time zone' suffix, e.g.:++<datetime type> ::=+    [ <left paren> <unsigned-int> <right paren> ]+    <with or without time zone>+<with or without time zone> ::= WITH TIME ZONE | WITHOUT TIME ZONE+    WITH TIME ZONE | WITHOUT TIME ZONE++= row type name++<row type> ::=+    ROW <left paren> <field definition> [ { <comma> <field definition> }... ] <right paren>++<field definition> ::= <identifier> <type name>++e.g.+row(a int, b char(5))++= interval type name++<interval type> ::= INTERVAL <interval datetime field> [TO <interval datetime field>]++<interval datetime field> ::=+  <datetime field> [ <left paren> <unsigned int> [ <comma> <unsigned int> ] <right paren> ]++= array type name++<array type> ::= <data type> ARRAY [ <left bracket> <unsigned integer> <right bracket> ]++= multiset type name++<multiset type>    ::=   <data type> MULTISET++A type name will parse into the 'smallest' constructor it will fit in+syntactically, e.g. a clob(5) will parse to a precision type name, not+a lob type name.++Unfortunately, to improve the error messages, there is a lot of (left)+factoring in this function, and it is a little dense.++> typeName :: Parser TypeName+> typeName =+>     (rowTypeName <|> intervalTypeName <|> otherTypeName)+>     <??*> tnSuffix+>   where+>     rowTypeName =+>         RowTypeName <$> (keyword_ "row" *> parens (commaSep1 rowField))+>     rowField = (,) <$> name <*> typeName+>     ----------------------------+>     intervalTypeName =+>         keyword_ "interval" *>+>         (uncurry IntervalTypeName <$> intervalQualifier)+>     ----------------------------+>     otherTypeName =+>         nameOfType <**>+>             (typeNameWithParens+>              <|> pure Nothing <**> (timeTypeName <|> charTypeName)+>              <|> pure TypeName)+>     nameOfType = reservedTypeNames <|> names+>     charTypeName = charSet <**> (option [] tcollate <$$$$> CharTypeName)+>                    <|> pure [] <**> (tcollate <$$$$> CharTypeName)+>     typeNameWithParens =+>         (openParen *> unsignedInteger)+>         <**> (closeParen *> precMaybeSuffix+>               <|> (precScaleTypeName <|> precLengthTypeName) <* closeParen)+>     precMaybeSuffix = (. Just) <$> (timeTypeName <|> charTypeName)+>                       <|> pure (flip PrecTypeName)+>     precScaleTypeName = (comma *> unsignedInteger) <$$$> PrecScaleTypeName+>     precLengthTypeName =+>         Just <$> lobPrecSuffix+>         <**> (optionMaybe lobUnits <$$$$> PrecLengthTypeName)+>         <|> pure Nothing <**> ((Just <$> lobUnits) <$$$$> PrecLengthTypeName)+>     timeTypeName = tz <$$$> TimeTypeName+>     ----------------------------+>     lobPrecSuffix = PrecK <$ keyword_ "k"+>                     <|> PrecM <$ keyword_ "m"+>                     <|> PrecG <$ keyword_ "g"+>                     <|> PrecT <$ keyword_ "t"+>                     <|> PrecP <$ keyword_ "p"+>     lobUnits = PrecCharacters <$ keyword_ "characters"+>                -- char and byte are the oracle spelling+>                -- todo: move these to oracle dialect+>                <|> PrecCharacters <$ keyword_ "char"+>                <|> PrecOctets <$ keyword_ "octets"+>                <|> PrecOctets <$ keyword_ "byte"+>     tz = True <$ keywords_ ["with", "time","zone"]+>          <|> False <$ keywords_ ["without", "time","zone"]+>     charSet = keywords_ ["character", "set"] *> names+>     tcollate = keyword_ "collate" *> names+>     ----------------------------+>     tnSuffix = multiset <|> array+>     multiset = MultisetTypeName <$ keyword_ "multiset"+>     array = keyword_ "array" *>+>         (optionMaybe (brackets unsignedInteger) <$$> ArrayTypeName)+>     ----------------------------+>     -- this parser handles the fixed set of multi word+>     -- type names, plus all the type names which are+>     -- reserved words+>     reservedTypeNames = (:[]) . Name Nothing . 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"+>         ]++= Scalar expressions++== simple literals++See the stringToken lexer below for notes on string literal syntax.++> stringLit :: Parser ScalarExpr+> stringLit = (\(s,e,t) -> StringLit s e t) <$> stringTokExtend++> numberLit :: Parser ScalarExpr+> numberLit = NumLit <$> sqlNumberTok False++> simpleLiteral :: Parser ScalarExpr+> simpleLiteral = numberLit <|> stringLit++== star, param, host param++=== star++used in select *, select x.*, and agg(*) variations, and some other+places as well. The parser doesn't attempt to check that the star is+in a valid context, it parses it OK in any scalar expression context.++> star :: Parser ScalarExpr+> star = Star <$ symbol "*"++== parameter++unnamed parameter or named parameter+use in e.g. select * from t where a = ?+select x from t where x > :param++> parameter :: Parser ScalarExpr+> parameter = choice+>     [Parameter <$ questionMark+>     ,HostParameter+>      <$> hostParamTok+>      <*> optionMaybe (keyword "indicator" *> hostParamTok)]++== positional arg++> positionalArg :: Parser ScalarExpr+> positionalArg = PositionalArg <$> positionalArgTok++== parens++scalar expression parens, row ctor and scalar subquery++> parensExpr :: Parser ScalarExpr+> parensExpr = parens $ choice+>     [SubQueryExpr SqSq <$> queryExpr+>     ,ctor <$> commaSep1 scalarExpr]+>   where+>     ctor [a] = Parens a+>     ctor as = SpecialOp [Name Nothing "rowctor"] as++== case, cast, exists, unique, array/multiset constructor, interval++All of these start with a fixed keyword which is reserved, so no other+syntax can start with the same keyword.++=== case expression++> caseExpr :: Parser ScalarExpr+> caseExpr =+>     Case <$> (keyword_ "case" *> optionMaybe scalarExpr)+>          <*> many1 whenClause+>          <*> optionMaybe elseClause+>          <* keyword_ "end"+>   where+>    whenClause = (,) <$> (keyword_ "when" *> commaSep1 scalarExpr)+>                     <*> (keyword_ "then" *> scalarExpr)+>    elseClause = keyword_ "else" *> scalarExpr++=== cast++cast: cast(expr as type)++> cast :: Parser ScalarExpr+> cast = keyword_ "cast" *>+>        parens (Cast <$> scalarExpr+>                     <*> (keyword_ "as" *> typeName))++=== exists, unique++subquery expression:+[exists|unique] (queryexpr)++> subquery :: Parser ScalarExpr+> subquery = SubQueryExpr <$> sqkw <*> parens queryExpr+>   where+>     sqkw = SqExists <$ keyword_ "exists" <|> SqUnique <$ keyword_ "unique"++=== array/multiset constructor++> arrayCtor :: Parser ScalarExpr+> arrayCtor = keyword_ "array" >>+>     choice+>     [ArrayCtor <$> parens queryExpr+>     ,Array (Iden [Name Nothing "array"]) <$> brackets (commaSep scalarExpr)]++As far as I can tell, table(query expr) is just syntax sugar for+multiset(query expr). It must be there for compatibility or something.++> multisetCtor :: Parser ScalarExpr+> multisetCtor =+>     choice+>     [keyword_ "multiset" >>+>      choice+>      [MultisetQueryCtor <$> parens queryExpr+>      ,MultisetCtor <$> brackets (commaSep scalarExpr)]+>     ,keyword_ "table" >>+>      MultisetQueryCtor <$> parens queryExpr]++> nextValueFor :: Parser ScalarExpr+> nextValueFor = keywords_ ["next","value","for"] >>+>     NextValueFor <$> names++=== interval++interval literals are a special case and we follow the grammar less+permissively here++parse SQL interval literals, something like+interval '5' day (3)+or+interval '5' month++if the literal looks like this:+interval 'something'++then it is parsed as a regular typed literal. It must have a+interval-datetime-field suffix to parse as an intervallit++It uses try because of a conflict with interval type names: todo, fix+this. also fix the monad -> applicative++> intervalLit :: Parser ScalarExpr+> intervalLit = try (keyword_ "interval" >> do+>     s <- optionMaybe $ choice [Plus <$ symbol_ "+"+>                               ,Minus <$ symbol_ "-"]+>     lit <- singleQuotesOnlyStringTok+>     q <- optionMaybe intervalQualifier+>     mkIt s lit q)+>   where+>     mkIt Nothing val Nothing = pure $ TypedLit (TypeName [Name Nothing "interval"]) val+>     mkIt s val (Just (a,b)) = pure $ IntervalLit s val a b+>     mkIt (Just {}) _val Nothing = fail "cannot use sign without interval qualifier"++== typed literal, app, special, aggregate, window, iden++All of these start with identifiers (some of the special functions+start with reserved keywords).++they are all variations on suffixes on the basic identifier parser++The windows is a suffix on the app parser++=== iden prefix term++all the scalar expressions which start with an identifier++(todo: really put all of them here instead of just some of them)++> idenExpr :: Parser ScalarExpr+> idenExpr =+>     -- todo: work out how to left factor this+>     try (TypedLit <$> typeName <*> singleQuotesOnlyStringTok)+>     <|> multisetSetFunction+>     <|> (try keywordFunction <**> app)+>     <|> (names <**> option Iden app)+>   where+>     -- this is a special case because set is a reserved keyword+>     -- and the names parser won't parse it+>     multisetSetFunction =+>         App [Name Nothing "set"] . (:[]) <$>+>         (try (keyword_ "set" *> openParen)+>          *> scalarExpr <* closeParen)+>     keywordFunction =+>         let makeKeywordFunction x = if map toLower x `elem` keywordFunctionNames+>                                     then return [Name Nothing x]+>                                     else fail ""+>         in unquotedIdentifierTok [] Nothing >>= makeKeywordFunction+>     -- todo: this list should be in the dialects+>     -- we should have tests to check these work+>     -- we should have tests to check if they are used elsewhere, you+>     -- get a keyword failure+>     -- these are the names of functions which are also keywords+>     -- so this identifier can only be used unquoted for a function application+>     -- and nowhere else+>     -- not sure if this list is 100% correct+>     -- todo: make a corresponding list of reserved keywords which can be+>     -- parsed as an identifier+>     keywordFunctionNames = ["abs"+>                            ,"all"+>                            ,"any"+>                            ,"array_agg"+>                            ,"avg"+>                            ,"ceil"+>                            ,"ceiling"+>                            ,"char_length"+>                            ,"character_length"+>                            ,"coalesce"+>                            ,"collect"+>                            ,"contains"+>                            ,"convert"+>                            ,"corr"+>                            ,"covar_pop"+>                            ,"covar_samp"+>                            ,"count"+>                            ,"cume_dist"+>                            ,"grouping"+>                            ,"intersection"+>                            ,"ln"+>                            ,"max"+>                            ,"mod"+>                            ,"percent_rank"+>                            ,"percentile_cont"+>                            ,"percentile_disc"+>                            ,"power"+>                            ,"rank"+>                            ,"regr_avgx"+>                            ,"regr_avgy"+>                            ,"regr_count"+>                            ,"regr_intercept"+>                            ,"regr_r2"+>                            ,"regr_slope"+>                            ,"regr_sxx"+>                            ,"regr_sxy"+>                            ,"regr_syy"+>                            ,"row"+>                            ,"row_number"+>                            ,"some"+>                            ,"stddev_pop"+>                            ,"stddev_samp"+>                            ,"sum"+>                            ,"upper"+>                            ,"var_pop"+>                            ,"var_samp"+>                            ,"width_bucket"+>                            -- window functions added here too+>                            ,"row_number"+>                            ,"rank"+>                            ,"dense_rank"+>                            ,"percent_rank"+>                            ,"cume_dist"+>                            ,"ntile"+>                            ,"lead"+>                            ,"lag"+>                            ,"first_value"+>                            ,"last_value"+>                            ,"nth_value"+>                            ]+++=== special++These are keyword operators which don't look like normal prefix,+postfix or infix binary operators. They mostly look like function+application but with keywords in the argument list instead of commas+to separate the arguments.++the special op keywords+parse an operator which is+operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)++> data SpecialOpKFirstArg = SOKNone+>                         | SOKOptional+>                         | SOKMandatory++> specialOpK :: String -- name of the operator+>            -> SpecialOpKFirstArg -- has a first arg without a keyword+>            -> [(String,Bool)] -- the other args with their keywords+>                               -- and whether they are optional+>            -> Parser ScalarExpr+> specialOpK opName firstArg kws =+>     keyword_ opName >> do+>     void openParen+>     let pfa = do+>               e <- scalarExpr+>               -- check we haven't parsed the first+>               -- keyword as an identifier+>               case (e,kws) of+>                   (Iden [Name Nothing i], (k,_):_)+>                       | map toLower i == k ->+>                           fail $ "cannot use keyword here: " ++ i+>                   _ -> return ()+>               pure e+>     fa <- case firstArg of+>          SOKNone -> pure Nothing+>          SOKOptional -> optionMaybe (try pfa)+>          SOKMandatory -> Just <$> pfa+>     as <- mapM parseArg kws+>     void closeParen+>     pure $ SpecialOpK [Name Nothing opName] fa $ catMaybes as+>   where+>     parseArg (nm,mand) =+>         let p = keyword_ nm >> scalarExpr+>         in fmap (nm,) <$> if mand+>                           then Just <$> p+>                           else optionMaybe (try p)++The actual operators:++EXTRACT( date_part FROM expression )++POSITION( string1 IN string2 )++SUBSTRING(extraction_string FROM starting_position [FOR length]+[COLLATE collation_name])++CONVERT(char_value USING conversion_char_name)++TRANSLATE(char_value USING translation_name)++OVERLAY(string PLACING embedded_string FROM start+[FOR length])++TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]+target_string+[COLLATE collation_name] )++> specialOpKs :: Parser ScalarExpr+> specialOpKs = choice $ map try+>     [extract, position, substring, convert, translate, overlay, trim]++> extract :: Parser ScalarExpr+> extract = specialOpK "extract" SOKMandatory [("from", True)]++> position :: Parser ScalarExpr+> position = specialOpK "position" SOKMandatory [("in", True)]++strictly speaking, the substring must have at least one of from and+for, but the parser doens't enforce this++> substring :: Parser ScalarExpr+> substring = specialOpK "substring" SOKMandatory+>                 [("from", False),("for", False)]++> convert :: Parser ScalarExpr+> convert = specialOpK "convert" SOKMandatory [("using", True)]+++> translate :: Parser ScalarExpr+> translate = specialOpK "translate" SOKMandatory [("using", True)]++> overlay :: Parser ScalarExpr+> overlay = specialOpK "overlay" SOKMandatory+>                 [("placing", True),("from", True),("for", False)]++trim is too different because of the optional char, so a custom parser+the both ' ' is filled in as the default if either parts are missing+in the source++> trim :: Parser ScalarExpr+> trim =+>     keyword "trim" >>+>     parens (mkTrim+>             <$> option "both" sides+>             <*> option " " singleQuotesOnlyStringTok+>             <*> (keyword_ "from" *> scalarExpr))+>   where+>     sides = choice ["leading" <$ keyword_ "leading"+>                    ,"trailing" <$ keyword_ "trailing"+>                    ,"both" <$ keyword_ "both"]+>     mkTrim fa ch fr =+>       SpecialOpK [Name Nothing "trim"] Nothing+>           $ catMaybes [Just (fa,StringLit "'" "'" ch)+>                       ,Just ("from", fr)]++=== app, aggregate, window++This parses all these variations:+normal function application with just a csv of scalar exprs+aggregate variations (distinct, order by in parens, filter and where+  suffixes)+window apps (fn/agg followed by over)++This code is also a little dense like the typename code because of+left factoring, later they will even have to be partially combined+together.++> app :: Parser ([Name] -> ScalarExpr)+> app =+>     openParen *> choice+>     [duplicates+>      <**> (commaSep1 scalarExpr+>            <**> (((option [] orderBy) <* closeParen)+>                  <**> (optionMaybe afilter <$$$$$> AggregateApp)))+>      -- separate cases with no all or distinct which must have at+>      -- least one scalar expr+>     ,commaSep1 scalarExpr+>      <**> choice+>           [closeParen *> choice+>                          [window+>                          ,withinGroup+>                          ,(Just <$> afilter) <$$$> aggAppWithoutDupeOrd+>                          ,pure (flip App)]+>           ,orderBy <* closeParen+>            <**> (optionMaybe afilter <$$$$> aggAppWithoutDupe)]+>      -- no scalarExprs: duplicates and order by not allowed+>     ,([] <$ closeParen) <**> option (flip App) (window <|> withinGroup)+>     ]+>   where+>     aggAppWithoutDupeOrd n es f = AggregateApp n SQDefault es [] f+>     aggAppWithoutDupe n = AggregateApp n SQDefault++> afilter :: Parser ScalarExpr+> afilter = keyword_ "filter" *> parens (keyword_ "where" *> scalarExpr)++> withinGroup :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)+> withinGroup =+>     (keywords_ ["within", "group"] *> parens orderBy) <$$$> AggregateAppGroup++==== window++parse a window call as a suffix of a regular function call+this looks like this:+functionname(args) over ([partition by ids] [order by orderitems])++No support for explicit frames yet.++TODO: add window support for other aggregate variations, needs some+changes to the syntax also++> window :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)+> window =+>   keyword_ "over" *> openParen *> option [] partitionBy+>   <**> (option [] orderBy+>         <**> (((optionMaybe frameClause) <* closeParen) <$$$$$> WindowApp))+>   where+>     partitionBy = keywords_ ["partition","by"] *> commaSep1 scalarExpr+>     frameClause =+>         frameRowsRange -- TODO: this 'and' could be an issue+>         <**> (choice [(keyword_ "between" *> frameLimit True)+>                       <**> ((keyword_ "and" *> frameLimit True)+>                             <$$$> FrameBetween)+>                       -- maybe this should still use a b expression+>                       -- for consistency+>                      ,frameLimit False <**> pure (flip FrameFrom)])+>     frameRowsRange = FrameRows <$ keyword_ "rows"+>                      <|> FrameRange <$ keyword_ "range"+>     frameLimit useB =+>         choice+>         [Current <$ keywords_ ["current", "row"]+>          -- todo: create an automatic left factor for stuff like this+>         ,keyword_ "unbounded" *>+>          choice [UnboundedPreceding <$ keyword_ "preceding"+>                 ,UnboundedFollowing <$ keyword_ "following"]+>         ,(if useB then scalarExprB else scalarExpr)+>          <**> (Preceding <$ keyword_ "preceding"+>                <|> Following <$ keyword_ "following")+>         ]++== suffixes++These are all generic suffixes on any scalar expr++=== in++in: two variations:+a in (expr0, expr1, ...)+a in (queryexpr)++> inSuffix :: Parser (ScalarExpr -> ScalarExpr)+> inSuffix =+>     mkIn <$> inty+>          <*> parens (choice+>                      [InQueryExpr <$> queryExpr+>                      ,InList <$> commaSep1 scalarExpr])+>   where+>     inty = choice [True <$ keyword_ "in"+>                   ,False <$ keywords_ ["not","in"]]+>     mkIn i v = \e -> In i e v++=== between++between:+expr between expr and expr++There is a complication when parsing between - when parsing the second+expression it is ambiguous when you hit an 'and' whether it is a+binary operator or part of the between. This code follows what+postgres does, which might be standard across SQL implementations,+which is that you can't have a binary and operator in the middle+expression in a between unless it is wrapped in parens. The 'bExpr+parsing' is used to create alternative scalar expression parser which+is identical to the normal one expect it doesn't recognise the binary+and operator. This is the call to scalarExprB.++> betweenSuffix :: Parser (ScalarExpr -> ScalarExpr)+> betweenSuffix =+>     makeOp <$> Name Nothing <$> opName+>            <*> scalarExprB+>            <*> (keyword_ "and" *> scalarExprB)+>   where+>     opName = choice+>              ["between" <$ keyword_ "between"+>              ,"not between" <$ try (keywords_ ["not","between"])]+>     makeOp n b c = \a -> SpecialOp [n] [a,b,c]++=== quantified comparison++a = any (select * from t)++> quantifiedComparisonSuffix :: Parser (ScalarExpr -> ScalarExpr)+> quantifiedComparisonSuffix = do+>     c <- comp+>     cq <- compQuan+>     q <- parens queryExpr+>     pure $ \v -> QuantifiedComparison v [c] cq q+>   where+>     comp = Name Nothing <$> choice (map symbol+>            ["=", "<>", "<=", "<", ">", ">="])+>     compQuan = choice+>                [CPAny <$ keyword_ "any"+>                ,CPSome <$ keyword_ "some"+>                ,CPAll <$ keyword_ "all"]++=== match++a match (select a from t)++> matchPredicateSuffix :: Parser (ScalarExpr -> ScalarExpr)+> matchPredicateSuffix = do+>     keyword_ "match"+>     u <- option False (True <$ keyword_ "unique")+>     q <- parens queryExpr+>     pure $ \v -> Match v u q++=== array subscript++> arraySuffix :: Parser (ScalarExpr -> ScalarExpr)+> arraySuffix = do+>     es <- brackets (commaSep scalarExpr)+>     pure $ \v -> Array v es++=== escape++It is going to be really difficult to support an arbitrary character+for the escape now there is a separate lexer ...++TODO: this needs fixing. Escape is only part of other nodes, and not a+separate suffix.++> {-escapeSuffix :: Parser (ScalarExpr -> ScalarExpr)+> escapeSuffix = do+>     ctor <- choice+>             [Escape <$ keyword_ "escape"+>             ,UEscape <$ keyword_ "uescape"]+>     c <- escapeChar+>     pure $ \v -> ctor v c+>   where+>     escapeChar :: Parser Char+>     escapeChar = (identifierTok [] Nothing <|> symbolTok Nothing) >>= oneOnly+>     oneOnly :: String -> Parser Char+>     oneOnly c = case c of+>                    [c'] -> return c'+>                    _ -> fail "escape char must be single char"+> -}++=== collate++> collateSuffix:: Parser (ScalarExpr -> ScalarExpr)+> collateSuffix = do+>     keyword_ "collate"+>     i <- names+>     pure $ \v -> Collate v i++== odbc syntax++the parser supports three kinds of odbc syntax, two of which are+scalar expressions (the other is a variation on joins)+++> odbcExpr :: Parser ScalarExpr+> odbcExpr = between (symbol "{") (symbol "}")+>            (odbcTimeLit <|> odbcFunc)+>   where+>     odbcTimeLit =+>         OdbcLiteral <$> choice [OLDate <$ keyword "d"+>                                ,OLTime <$ keyword "t"+>                                ,OLTimestamp <$ keyword "ts"]+>                     <*> singleQuotesOnlyStringTok+>     -- todo: this parser is too general, the expr part+>     -- should be only a function call (from a whitelist of functions)+>     -- or the extract operator+>     odbcFunc = OdbcFunc <$> (keyword "fn" *> scalarExpr)++==  operators++The 'regular' operators in this parsing and in the abstract syntax are+unary prefix, unary postfix and binary infix operators. The operators+can be symbols (a + b), single keywords (a and b) or multiple keywords+(a is similar to b).++TODO: carefully review the precedences and associativities.++TODO: to fix the parsing completely, I think will need to parse+without precedence and associativity and fix up afterwards, since SQL+syntax is way too messy. It might be possible to avoid this if we+wanted to avoid extensibility and to not be concerned with parse error+messages, but both of these are too important.++> opTable :: Bool -> [[E.Operator [Token] ParseState Identity ScalarExpr]]+> opTable bExpr =+>         [-- parse match and quantified comparisons as postfix ops+>           -- todo: left factor the quantified comparison with regular+>           -- binary comparison, somehow+>          [E.Postfix $ try quantifiedComparisonSuffix+>          ,E.Postfix matchPredicateSuffix+>          ]++>         ,[binarySym "." E.AssocLeft]++>         ,[postfix' arraySuffix+>          ,postfix' collateSuffix]++>         ,[prefixSym "+", prefixSym "-"]++>         ,[binarySym "^" E.AssocLeft]++>         ,[binarySym "*" E.AssocLeft+>          ,binarySym "/" E.AssocLeft+>          ,binarySym "%" E.AssocLeft]++>         ,[binarySym "+" E.AssocLeft+>          ,binarySym "-" E.AssocLeft]++>         ,[binarySym "||" E.AssocRight+>          ,prefixSym "~"+>          ,binarySym "&" E.AssocRight+>          ,binarySym "|" E.AssocRight]++>         ,[binaryKeyword "overlaps" E.AssocNone]++>         ,[binaryKeyword "like" E.AssocNone+>          -- have to use try with inSuffix because of a conflict+>          -- with 'in' in position function, and not between+>          -- between also has a try in it to deal with 'not'+>          -- ambiguity+>          ,E.Postfix $ try inSuffix+>          ,E.Postfix betweenSuffix]+>          -- todo: figure out where to put the try?+>          ++ [binaryKeywords $ makeKeywordTree+>              ["not like"+>              ,"is similar to"+>              ,"is not similar to"]]+>          ++ [multisetBinOp]++>         ,[binarySym "<" E.AssocNone+>          ,binarySym ">" E.AssocNone+>          ,binarySym ">=" E.AssocNone+>          ,binarySym "<=" E.AssocNone+>          ,binarySym "!=" E.AssocRight+>          ,binarySym "<>" E.AssocRight+>          ,binarySym "=" E.AssocRight]++>         ,[postfixKeywords $ makeKeywordTree+>              ["is null"+>              ,"is not null"+>              ,"is true"+>              ,"is not true"+>              ,"is false"+>              ,"is not false"+>              ,"is unknown"+>              ,"is not unknown"]]+>          ++ [binaryKeywords $ makeKeywordTree+>              ["is distinct from"+>              ,"is not distinct from"]]++>         ,[prefixKeyword "not"]++>         ,if bExpr then [] else [binaryKeyword "and" E.AssocLeft]++>         ,[binaryKeyword "or" E.AssocLeft]++>        ]+>   where+>     binarySym nm assoc = binary (symbol_ nm) nm assoc+>     binaryKeyword nm assoc = binary (keyword_ nm) nm assoc+>     binaryKeywords p =+>         E.Infix (do+>                  o <- try p+>                  pure (\a b -> BinOp a [Name Nothing $ unwords o] b))+>             E.AssocNone+>     postfixKeywords p =+>       postfix' $ do+>           o <- try p+>           pure $ PostfixOp [Name Nothing $ unwords o]+>     binary p nm assoc =+>       E.Infix (p >> pure (\a b -> BinOp a [Name Nothing nm] b)) assoc+>     multisetBinOp = E.Infix (do+>         keyword_ "multiset"+>         o <- choice [Union <$ keyword_ "union"+>                     ,Intersect <$ keyword_ "intersect"+>                     ,Except <$ keyword_ "except"]+>         d <- option SQDefault duplicates+>         pure (\a b -> MultisetBinOp a o d b))+>           E.AssocLeft+>     prefixKeyword nm = prefix (keyword_ nm) nm+>     prefixSym nm = prefix (symbol_ nm) nm+>     prefix p nm = prefix' (p >> pure (PrefixOp [Name Nothing nm]))+>     -- hack from here+>     -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported+>     -- not implemented properly yet+>     -- I don't think this will be enough for all cases+>     -- at least it works for 'not not a'+>     -- ok: "x is not true is not true"+>     -- no work: "x is not true is not null"+>     prefix'  p = E.Prefix  . chainl1 p $ pure       (.)+>     postfix' p = E.Postfix . chainl1 p $ pure (flip (.))++== scalar expression top level++This parses most of the scalar exprs.The order of the parsers and use+of try is carefully done to make everything work. It is a little+fragile and could at least do with some heavy explanation. Update: the+'try's have migrated into the individual parsers, they still need+documenting/fixing.++> scalarExpr :: Parser ScalarExpr+> scalarExpr = E.buildExpressionParser (opTable False) term++> term :: Parser ScalarExpr+> term = choice [simpleLiteral+>               ,parameter+>               ,positionalArg+>               ,star+>               ,parensExpr+>               ,caseExpr+>               ,cast+>               ,arrayCtor+>               ,multisetCtor+>               ,nextValueFor+>               ,subquery+>               ,intervalLit+>               ,specialOpKs+>               ,idenExpr+>               ,odbcExpr]+>        <?> "scalar expression"++expose the b expression for window frame clause range between++> scalarExprB :: Parser ScalarExpr+> scalarExprB = E.buildExpressionParser (opTable True) term++== helper parsers++This is used in interval literals and in interval type names.++> intervalQualifier :: Parser (IntervalTypeField,Maybe IntervalTypeField)+> intervalQualifier =+>     (,) <$> intervalField+>         <*> optionMaybe (keyword_ "to" *> intervalField)+>   where+>     intervalField =+>         Itf+>         <$> datetimeField+>         <*> optionMaybe+>             (parens ((,) <$> unsignedInteger+>                          <*> optionMaybe (comma *> unsignedInteger)))++TODO: use datetime field in extract also+use a data type for the datetime field?++> datetimeField :: Parser String+> datetimeField = choice (map keyword ["year","month","day"+>                                     ,"hour","minute","second"])+>                 <?> "datetime field"++This is used in multiset operations (scalar expr), selects (query expr)+and set operations (query expr).++> duplicates :: Parser SetQuantifier+> duplicates =+>     choice [All <$ keyword_ "all"+>            ,Distinct <$ keyword "distinct"]++-------------------------------------------------++= query expressions++== select lists++> selectItem :: Parser (ScalarExpr,Maybe Name)+> selectItem = (,) <$> scalarExpr <*> optionMaybe als+>   where als = optional (keyword_ "as") *> name++> selectList :: Parser [(ScalarExpr,Maybe Name)]+> selectList = commaSep1 selectItem++== from++Here is the rough grammar for joins++tref+(cross | [natural] ([inner] | (left | right | full) [outer])) join+tref+[on expr | using (...)]++TODO: either use explicit 'operator precedence' parsers or build+expression parser for the 'tref operators' such as joins, lateral,+aliases.++> from :: Parser [TableRef]+> from = keyword_ "from" *> commaSep1 tref+>   where+>     -- TODO: use P (a->) for the join tref suffix+>     -- chainl or buildexpressionparser+>     tref = nonJoinTref >>= optionSuffix joinTrefSuffix+>     nonJoinTref = choice+>         [parens $ choice+>              [TRQueryExpr <$> queryExpr+>              ,TRParens <$> tref]+>         ,TRLateral <$> (keyword_ "lateral"+>                         *> nonJoinTref)+>         ,do+>          n <- names+>          choice [TRFunction n+>                  <$> parens (commaSep scalarExpr)+>                 ,pure $ TRSimple n]+>          -- todo: I think you can only have outer joins inside the oj,+>          -- not sure.+>         ,TROdbc <$> (symbol "{" *> keyword_ "oj" *> tref <* symbol "}")+>         ] <??> aliasSuffix+>     aliasSuffix = fromAlias <$$> TRAlias+>     joinTrefSuffix t =+>         (TRJoin t <$> option False (True <$ keyword_ "natural")+>                   <*> joinType+>                   <*> nonJoinTref+>                   <*> optionMaybe joinCondition)+>         >>= optionSuffix joinTrefSuffix++TODO: factor the join stuff to produce better error messages (and make+it more readable)++> joinType :: Parser JoinType+> joinType = choice+>     [JCross <$ keyword_ "cross" <* keyword_ "join"+>     ,JInner <$ keyword_ "inner" <* keyword_ "join"+>     ,JLeft <$ keyword_ "left"+>            <* optional (keyword_ "outer")+>            <* keyword_ "join"+>     ,JRight <$ keyword_ "right"+>             <* optional (keyword_ "outer")+>             <* keyword_ "join"+>     ,JFull <$ keyword_ "full"+>            <* optional (keyword_ "outer")+>            <* keyword_ "join"+>     ,JInner <$ keyword_ "join"]++> joinCondition :: Parser JoinCondition+> joinCondition = choice+>     [keyword_ "on" >> JoinOn <$> scalarExpr+>     ,keyword_ "using" >> JoinUsing <$> parens (commaSep1 name)]++> fromAlias :: Parser Alias+> fromAlias = Alias <$> tableAlias <*> columnAliases+>   where+>     tableAlias = optional (keyword_ "as") *> name+>     columnAliases = optionMaybe $ parens $ commaSep1 name++== simple other parts++Parsers for where, group by, having, order by and limit, which are+pretty trivial.++> whereClause :: Parser ScalarExpr+> whereClause = keyword_ "where" *> scalarExpr++> groupByClause :: Parser [GroupingExpr]+> groupByClause = keywords_ ["group","by"] *> commaSep1 groupingExpression+>   where+>     groupingExpression = choice+>       [keyword_ "cube" >>+>        Cube <$> parens (commaSep groupingExpression)+>       ,keyword_ "rollup" >>+>        Rollup <$> parens (commaSep groupingExpression)+>       ,GroupingParens <$> parens (commaSep groupingExpression)+>       ,keywords_ ["grouping", "sets"] >>+>        GroupingSets <$> parens (commaSep groupingExpression)+>       ,SimpleGroup <$> scalarExpr+>       ]++> having :: Parser ScalarExpr+> having = keyword_ "having" *> scalarExpr++> orderBy :: Parser [SortSpec]+> orderBy = keywords_ ["order","by"] *> commaSep1 ob+>   where+>     ob = SortSpec+>          <$> scalarExpr+>          <*> option DirDefault (choice [Asc <$ keyword_ "asc"+>                                        ,Desc <$ keyword_ "desc"])+>          <*> option NullsOrderDefault+>              -- todo: left factor better+>              (keyword_ "nulls" >>+>                     choice [NullsFirst <$ keyword "first"+>                            ,NullsLast <$ keyword "last"])++allows offset and fetch in either order++ postgresql offset without row(s) and limit instead of fetch also++> offsetFetch :: Parser (Maybe ScalarExpr, Maybe ScalarExpr)+> offsetFetch = permute ((,) <$?> (Nothing, Just <$> offset)+>                            <|?> (Nothing, Just <$> fetch))++> offset :: Parser ScalarExpr+> offset = keyword_ "offset" *> scalarExpr+>          <* option () (choice [keyword_ "rows"+>                               ,keyword_ "row"])++> fetch :: Parser ScalarExpr+> fetch = fetchFirst <|> limit+>   where+>     fetchFirst = guardDialect [ANSI2011]+>                  *> fs *> scalarExpr <* ro+>     fs = makeKeywordTree ["fetch first", "fetch next"]+>     ro = makeKeywordTree ["rows only", "row only"]+>     -- todo: not in ansi sql dialect+>     limit = guardDialect [MySQL] *>+>             keyword_ "limit" *> scalarExpr++== 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 scalarExpr))+>     table = keyword_ "table" >> Table <$> names++local data type to help with parsing the bit after the select list,+called 'table expression' in the ansi sql grammar. Maybe this should+be in the public syntax?++> data TableExpression+>     = TableExpression+>       {_teFrom :: [TableRef]+>       ,_teWhere :: Maybe ScalarExpr+>       ,_teGroupBy :: [GroupingExpr]+>       ,_teHaving :: Maybe ScalarExpr+>       ,_teOrderBy :: [SortSpec]+>       ,_teOffset :: Maybe ScalarExpr+>       ,_teFetchFirst :: Maybe ScalarExpr}++> tableExpression :: Parser TableExpression+> tableExpression = mkTe <$> from+>                        <*> optionMaybe whereClause+>                        <*> option [] groupByClause+>                        <*> optionMaybe having+>                        <*> option [] orderBy+>                        <*> offsetFetch+>  where+>     mkTe f w g h od (ofs,fe) =+>         TableExpression f w g h od ofs fe++> setOp :: Parser (QueryExpr -> QueryExpr -> QueryExpr)+> setOp = cq+>         <$> setOpK+>         <*> option SQDefault duplicates+>         <*> corr+>   where+>     cq o d c q0 q1 = QueryExprSetOp q0 o d c q1+>     setOpK = choice [Union <$ keyword_ "union"+>                     ,Intersect <$ keyword_ "intersect"+>                     ,Except <$ keyword_ "except"]+>             <?> "set operator"+>     corr = option Respectively (Corresponding <$ keyword_ "corresponding")+++wrapper for query expr which ignores optional trailing semicolon.++TODO: change style++> topLevelQueryExpr :: Parser QueryExpr+> topLevelQueryExpr = queryExpr <??> (id <$ semi)++> topLevelStatement :: Parser Statement+> topLevelStatement = statement <??> (id <$ semi)++-------------------------++= Statements++> statement :: Parser Statement+> statement = choice+>     [keyword_ "create" *> choice [createSchema+>                                  ,createTable+>                                  ,createView+>                                  ,createDomain+>                                  ,createSequence+>                                  ,createRole+>                                  ,createAssertion]+>     ,keyword_ "alter" *> choice [alterTable+>                                 ,alterDomain+>                                 ,alterSequence]+>     ,keyword_ "drop" *> choice [dropSchema+>                                ,dropTable+>                                ,dropView+>                                ,dropDomain+>                                ,dropSequence+>                                ,dropRole+>                                ,dropAssertion]+>     ,delete+>     ,truncateSt+>     ,insert+>     ,update+>     ,startTransaction+>     ,savepoint+>     ,releaseSavepoint+>     ,commit+>     ,rollback+>     ,grant+>     ,revoke+>     ,SelectStatement <$> queryExpr+>     ]++> createSchema :: Parser Statement+> createSchema = keyword_ "schema" >>+>     CreateSchema <$> names++> createTable :: Parser Statement+> createTable = keyword_ "table" >>+>     CreateTable+>     <$> names+>     -- todo: is this order mandatory or is it a perm?+>     <*> parens (commaSep1 (uncurry TableConstraintDef <$> tableConstraintDef+>                            <|> TableColumnDef <$> columnDef))++> columnDef :: Parser ColumnDef+> columnDef = ColumnDef <$> name <*> typeName+>             <*> optionMaybe defaultClause+>             <*> option [] (many1 colConstraintDef)+>   where+>     defaultClause = choice [+>         keyword_ "default" >>+>         DefaultClause <$> scalarExpr+>         -- todo: left factor+>        ,try (keywords_ ["generated","always","as"] >>+>              GenerationClause <$> parens scalarExpr)+>        ,keyword_ "generated" >>+>         IdentityColumnSpec+>         <$> (GeneratedAlways <$ keyword_ "always"+>              <|> GeneratedByDefault <$ keywords_ ["by", "default"])+>         <*> (keywords_ ["as", "identity"] *>+>              option [] (parens sequenceGeneratorOptions))+>        ]++> tableConstraintDef :: Parser (Maybe [Name], TableConstraint)+> tableConstraintDef =+>     (,)+>     <$> (optionMaybe (keyword_ "constraint" *> names))+>     <*> (unique <|> primaryKey <|> check <|> references)+>   where+>     unique = keyword_ "unique" >>+>         TableUniqueConstraint <$> parens (commaSep1 name)+>     primaryKey = keywords_ ["primary", "key"] >>+>         TablePrimaryKeyConstraint <$> parens (commaSep1 name)+>     check = keyword_ "check" >> TableCheckConstraint <$> parens scalarExpr+>     references = keywords_ ["foreign", "key"] >>+>         (\cs ft ftcs m (u,d) -> TableReferencesConstraint cs ft ftcs m u d)+>         <$> parens (commaSep1 name)+>         <*> (keyword_ "references" *> names)+>         <*> optionMaybe (parens $ commaSep1 name)+>         <*> refMatch+>         <*> refActions++> refMatch :: Parser ReferenceMatch+> refMatch = option DefaultReferenceMatch+>             (keyword_ "match" *>+>              choice [MatchFull <$ keyword_ "full"+>                     ,MatchPartial <$ keyword_ "partial"+>                     ,MatchSimple <$ keyword_ "simple"])+> refActions :: Parser (ReferentialAction,ReferentialAction)+> refActions = permute ((,) <$?> (DefaultReferentialAction, onUpdate)+>                           <|?> (DefaultReferentialAction, onDelete))+>   where+>     -- todo: left factor?+>     onUpdate = try (keywords_ ["on", "update"]) *> referentialAction+>     onDelete = try (keywords_ ["on", "delete"]) *> referentialAction+>     referentialAction = choice [+>          RefCascade <$ keyword_ "cascade"+>          -- todo: left factor?+>         ,RefSetNull <$ try (keywords_ ["set", "null"])+>         ,RefSetDefault <$ try (keywords_ ["set", "default"])+>         ,RefRestrict <$ keyword_ "restrict"+>         ,RefNoAction <$ keywords_ ["no", "action"]]++> colConstraintDef :: Parser ColConstraintDef+> colConstraintDef =+>     ColConstraintDef+>     <$> (optionMaybe (keyword_ "constraint" *> names))+>     <*> (notNull <|> unique <|> primaryKey <|> check <|> references)+>   where+>     notNull = ColNotNullConstraint <$ keywords_ ["not", "null"]+>     unique = ColUniqueConstraint <$ keyword_ "unique"+>     primaryKey = ColPrimaryKeyConstraint <$ keywords_ ["primary", "key"]+>     check = keyword_ "check" >> ColCheckConstraint <$> parens scalarExpr+>     references = keyword_ "references" >>+>         (\t c m (ou,od) -> ColReferencesConstraint t c m ou od)+>         <$> names+>         <*> optionMaybe (parens name)+>         <*> refMatch+>         <*> refActions++slightly hacky parser for signed integers++> signedInteger :: Parser Integer+> signedInteger =+>     (*) <$> option 1 (1 <$ symbol "+" <|> (-1) <$ symbol "-")+>     <*> unsignedInteger++> sequenceGeneratorOptions :: Parser [SequenceGeneratorOption]+> sequenceGeneratorOptions =+>          -- todo: could try to combine exclusive options+>          -- such as cycle and nocycle+>          -- sort out options which are sometimes not allowed+>          -- as datatype, and restart with+>     permute ((\a b c d e f g h j k -> catMaybes [a,b,c,d,e,f,g,h,j,k])+>                   <$?> nj startWith+>                   <|?> nj dataType+>                   <|?> nj restart+>                   <|?> nj incrementBy+>                   <|?> nj maxValue+>                   <|?> nj noMaxValue+>                   <|?> nj minValue+>                   <|?> nj noMinValue+>                   <|?> nj scycle+>                   <|?> nj noCycle+>                  )+>   where+>     nj p = (Nothing,Just <$> p)+>     startWith = keywords_ ["start", "with"] >>+>                 SGOStartWith <$> signedInteger+>     dataType = keyword_ "as" >>+>                SGODataType <$> typeName+>     restart = keyword_ "restart" >>+>               SGORestart <$> optionMaybe (keyword_ "with" *> signedInteger)+>     incrementBy = keywords_ ["increment", "by"] >>+>                 SGOIncrementBy <$> signedInteger+>     maxValue = keyword_ "maxvalue" >>+>                 SGOMaxValue <$> signedInteger+>     noMaxValue = SGONoMaxValue <$ try (keywords_ ["no","maxvalue"])+>     minValue = keyword_ "minvalue" >>+>                 SGOMinValue <$> signedInteger+>     noMinValue = SGONoMinValue <$ try (keywords_ ["no","minvalue"])+>     scycle = SGOCycle <$ keyword_ "cycle"+>     noCycle = SGONoCycle <$ try (keywords_ ["no","cycle"])+++> alterTable :: Parser Statement+> alterTable = keyword_ "table" >>+>     -- the choices have been ordered so that it works+>     AlterTable <$> names <*> choice [addConstraint+>                                     ,dropConstraint+>                                     ,addColumnDef+>                                     ,alterColumn+>                                     ,dropColumn+>                                     ]+>   where+>     addColumnDef = try (keyword_ "add"+>                         *> optional (keyword_ "column")) >>+>                    AddColumnDef <$> columnDef+>     alterColumn = keyword_ "alter" >> optional (keyword_ "column") >>+>                   name <**> choice [setDefault+>                                    ,dropDefault+>                                    ,setNotNull+>                                    ,dropNotNull+>                                    ,setDataType]+>     setDefault :: Parser (Name -> AlterTableAction)+>     -- todo: left factor+>     setDefault = try (keywords_ ["set","default"]) >>+>                  scalarExpr <$$> AlterColumnSetDefault+>     dropDefault = AlterColumnDropDefault <$ try (keywords_ ["drop","default"])+>     setNotNull = AlterColumnSetNotNull <$ try (keywords_ ["set","not","null"])+>     dropNotNull = AlterColumnDropNotNull <$ try (keywords_ ["drop","not","null"])+>     setDataType = try (keywords_ ["set","data","type"]) >>+>                   typeName <$$> AlterColumnSetDataType+>     dropColumn = try (keyword_ "drop" *> optional (keyword_ "column")) >>+>                  DropColumn <$> name <*> dropBehaviour+>     -- todo: left factor, this try is especially bad+>     addConstraint = try (keyword_ "add" >>+>         uncurry AddTableConstraintDef <$> tableConstraintDef)+>     dropConstraint = try (keywords_ ["drop","constraint"]) >>+>         DropTableConstraintDef <$> names <*> dropBehaviour+++> dropSchema :: Parser Statement+> dropSchema = keyword_ "schema" >>+>     DropSchema <$> names <*> dropBehaviour++> dropTable :: Parser Statement+> dropTable = keyword_ "table" >>+>     DropTable <$> names <*> dropBehaviour++> createView :: Parser Statement+> createView =+>     CreateView+>     <$> (option False (True <$ keyword_ "recursive") <* keyword_ "view")+>     <*> names+>     <*> optionMaybe (parens (commaSep1 name))+>     <*> (keyword_ "as" *> queryExpr)+>     <*> optionMaybe (choice [+>             -- todo: left factor+>             DefaultCheckOption <$ try (keywords_ ["with", "check", "option"])+>            ,CascadedCheckOption <$ try (keywords_ ["with", "cascaded", "check", "option"])+>            ,LocalCheckOption <$ try (keywords_ ["with", "local", "check", "option"])+>             ])++> dropView :: Parser Statement+> dropView = keyword_ "view" >>+>     DropView <$> names <*> dropBehaviour++> createDomain :: Parser Statement+> createDomain = keyword_ "domain" >>+>     CreateDomain+>     <$> names+>     <*> (optional (keyword_ "as") *> typeName)+>     <*> optionMaybe (keyword_ "default" *> scalarExpr)+>     <*> many con+>   where+>     con = (,) <$> optionMaybe (keyword_ "constraint" *> names)+>           <*> (keyword_ "check" *> parens scalarExpr)++> alterDomain :: Parser Statement+> alterDomain = keyword_ "domain" >>+>     AlterDomain+>     <$> names+>     <*> (setDefault <|> constraint+>          <|> (keyword_ "drop" *> (dropDefault <|> dropConstraint)))+>   where+>     setDefault = keywords_ ["set", "default"] >> ADSetDefault <$> scalarExpr+>     constraint = keyword_ "add" >>+>        ADAddConstraint+>        <$> optionMaybe (keyword_ "constraint" *> names)+>        <*> (keyword_ "check" *> parens scalarExpr)+>     dropDefault = ADDropDefault <$ keyword_ "default"+>     dropConstraint = keyword_ "constraint" >> ADDropConstraint <$> names++> dropDomain :: Parser Statement+> dropDomain = keyword_ "domain" >>+>     DropDomain <$> names <*> dropBehaviour++> createSequence :: Parser Statement+> createSequence = keyword_ "sequence" >>+>     CreateSequence+>     <$> names+>     <*> sequenceGeneratorOptions++> alterSequence :: Parser Statement+> alterSequence = keyword_ "sequence" >>+>     AlterSequence+>     <$> names+>     <*> sequenceGeneratorOptions++> dropSequence :: Parser Statement+> dropSequence = keyword_ "sequence" >>+>     DropSequence <$> names <*> dropBehaviour++> createAssertion :: Parser Statement+> createAssertion = keyword_ "assertion" >>+>     CreateAssertion+>     <$> names+>     <*> (keyword_ "check" *> parens scalarExpr)+++> dropAssertion :: Parser Statement+> dropAssertion = keyword_ "assertion" >>+>     DropAssertion <$> names <*> dropBehaviour++-----------------++= dml++> delete :: Parser Statement+> delete = keywords_ ["delete","from"] >>+>     Delete+>     <$> names+>     <*> optionMaybe (optional (keyword_ "as") *> name)+>     <*> optionMaybe (keyword_ "where" *> scalarExpr)++> truncateSt :: Parser Statement+> truncateSt = keywords_ ["truncate", "table"] >>+>     Truncate+>     <$> names+>     <*> option DefaultIdentityRestart+>         (ContinueIdentity <$ keywords_ ["continue","identity"]+>          <|> RestartIdentity <$ keywords_ ["restart","identity"])++> insert :: Parser Statement+> insert = keywords_ ["insert", "into"] >>+>     Insert+>     <$> names+>     <*> optionMaybe (parens $ commaSep1 name)+>     <*> (DefaultInsertValues <$ keywords_ ["default", "values"]+>          <|> InsertQuery <$> queryExpr)++> update :: Parser Statement+> update = keywords_ ["update"] >>+>     Update+>     <$> names+>     <*> optionMaybe (optional (keyword_ "as") *> name)+>     <*> (keyword_ "set" *> commaSep1 setClause)+>     <*> optionMaybe (keyword_ "where" *> scalarExpr)+>   where+>     setClause = multipleSet <|> singleSet+>     multipleSet = SetMultiple+>                   <$> parens (commaSep1 names)+>                   <*> (symbol "=" *> parens (commaSep1 scalarExpr))+>     singleSet = Set+>                 <$> names+>                 <*> (symbol "=" *> scalarExpr)++> dropBehaviour :: Parser DropBehaviour+> dropBehaviour =+>     option DefaultDropBehaviour+>     (Restrict <$ keyword_ "restrict"+>     <|> Cascade <$ keyword_ "cascade")++-----------------------------++= transaction management++> startTransaction :: Parser Statement+> startTransaction = StartTransaction <$ keywords_ ["start","transaction"]++> savepoint :: Parser Statement+> savepoint = keyword_ "savepoint" >>+>     Savepoint <$> name++> releaseSavepoint :: Parser Statement+> releaseSavepoint = keywords_ ["release","savepoint"] >>+>     ReleaseSavepoint <$> name++> commit :: Parser Statement+> commit = Commit <$ keyword_ "commit" <* optional (keyword_ "work")++> rollback :: Parser Statement+> rollback = keyword_ "rollback" >> optional (keyword_ "work") >>+>     Rollback <$> optionMaybe (keywords_ ["to", "savepoint"] *> name)+++------------------------------++= Access control++TODO: fix try at the 'on'++> grant :: Parser Statement+> grant = keyword_ "grant" >> (try priv <|> role)+>   where+>     priv = GrantPrivilege+>            <$> commaSep privilegeAction+>            <*> (keyword_ "on" *> privilegeObject)+>            <*> (keyword_ "to" *> commaSep name)+>            <*> option WithoutGrantOption+>                (WithGrantOption <$ keywords_ ["with","grant","option"])+>     role = GrantRole+>            <$> commaSep name+>            <*> (keyword_ "to" *> commaSep name)+>            <*> option WithoutAdminOption+>                (WithAdminOption <$ keywords_ ["with","admin","option"])++> createRole :: Parser Statement+> createRole = keyword_ "role" >>+>     CreateRole <$> name++> dropRole :: Parser Statement+> dropRole = keyword_ "role" >>+>     DropRole <$> name++TODO: fix try at the 'on'++> revoke :: Parser Statement+> revoke = keyword_ "revoke" >> (try priv <|> role)+>   where+>     priv = RevokePrivilege+>            <$> option NoGrantOptionFor+>                (GrantOptionFor <$ keywords_ ["grant","option","for"])+>            <*> commaSep privilegeAction+>            <*> (keyword_ "on" *> privilegeObject)+>            <*> (keyword_ "from" *> commaSep name)+>            <*> dropBehaviour+>     role = RevokeRole+>            <$> option NoAdminOptionFor+>                (AdminOptionFor <$ keywords_ ["admin","option", "for"])+>            <*> commaSep name+>            <*> (keyword_ "from" *> commaSep name)+>            <*> dropBehaviour++> privilegeAction :: Parser PrivilegeAction+> privilegeAction = choice+>     [PrivAll <$ keywords_ ["all","privileges"]+>     ,keyword_ "select" >>+>      PrivSelect <$> option [] (parens $ commaSep name)+>     ,PrivDelete <$ keyword_ "delete"+>     ,PrivUsage <$ keyword_ "usage"+>     ,PrivTrigger <$ keyword_ "trigger"+>     ,PrivExecute <$ keyword_ "execute"+>     ,keyword_ "insert" >>+>      PrivInsert <$> option [] (parens $ commaSep name)+>     ,keyword_ "update" >>+>      PrivUpdate <$> option [] (parens $ commaSep name)+>     ,keyword_ "references" >>+>      PrivReferences <$> option [] (parens $ commaSep name)+>     ]++> privilegeObject :: Parser PrivilegeObject+> privilegeObject = choice+>     [keyword_ "domain" >> PrivDomain <$> names+>     ,keyword_ "type" >> PrivType <$> names+>     ,keyword_ "sequence" >> PrivSequence <$> names+>     ,keywords_ ["specific","function"] >> PrivFunction <$> names+>     ,optional (keyword_ "table") >> PrivTable <$> names+>     ]+++----------------------------++wrapper to parse a series of statements. They must be separated by+semicolon, but for the last statement, the trailing semicolon is+optional.++TODO: change style++> statements :: Parser [Statement]+> statements = (:[]) <$> statement+>              >>= optionSuffix ((semi *>) . pure)+>              >>= optionSuffix (\p -> (p++) <$> statements)++----------------------------------------------++= multi keyword helper++This helper is to help parsing multiple options of multiple keywords+with similar prefixes, e.g. parsing 'is null' and 'is not null'.++use to left factor/ improve:+typed literal and general identifiers+not like, not in, not between operators+help with factoring keyword functions and other app-likes+the join keyword sequences+fetch first/next+row/rows only++There is probably a simpler way of doing this but I am a bit+thick.++> makeKeywordTree :: [String] -> Parser [String]+> makeKeywordTree sets =+>     parseTrees (sort $ map words sets)+>   where+>     parseTrees :: [[String]] -> Parser [String]+>     parseTrees ws = do+>       let gs :: [[[String]]]+>           gs = groupBy ((==) `on` safeHead) ws+>       choice $ map parseGroup gs+>     parseGroup :: [[String]] -> Parser [String]+>     parseGroup l@((k:_):_) = do+>         keyword_ k+>         let tls = catMaybes $ map safeTail l+>             pr = (k:) <$> parseTrees tls+>         if (or $ map null tls)+>           then pr <|> pure [k]+>           else pr+>     parseGroup _ = guard False >> error "impossible"+>     safeHead (x:_) = Just x+>     safeHead [] = Nothing+>     safeTail (_:x) = Just x+>     safeTail [] = Nothing++------------------------------------------------++= lexing++TODO: push checks into here:+keyword blacklists+unsigned integer match+symbol matching+keyword matching++> stringTok :: Parser (String,String,String)+> stringTok = mytoken (\tok ->+>     case tok of+>       L.SqlString s e t -> Just (s,e,t)+>       _ -> Nothing)++> singleQuotesOnlyStringTok :: Parser String+> singleQuotesOnlyStringTok = mytoken (\tok ->+>     case tok of+>       L.SqlString "'" "'" t -> Just t+>       _ -> Nothing)++This is to support SQL strings where you can write+'part of a string' ' another part'+and it will parse as a single string++It is only allowed when all the strings are quoted with ' atm.++> stringTokExtend :: Parser (String,String,String)+> stringTokExtend = do+>     (s,e,x) <- stringTok+>     choice [+>          do+>          guard (s == "'" && e == "'")+>          (s',e',y) <- stringTokExtend+>          guard (s' == "'" && e' == "'")+>          return $ (s,e,x ++ y)+>         ,return (s,e,x)+>         ]++> hostParamTok :: Parser String+> hostParamTok = mytoken (\tok ->+>     case tok of+>       L.PrefixedVariable c p -> Just (c:p)+>       _ -> Nothing)++> positionalArgTok :: Parser Int+> positionalArgTok = mytoken (\tok ->+>     case tok of+>       L.PositionalArg p -> Just p+>       _ -> Nothing)+++> sqlNumberTok :: Bool -> Parser String+> sqlNumberTok intOnly = mytoken (\tok ->+>     case tok of+>       L.SqlNumber p | not intOnly || all isDigit p -> Just p+>       _ -> Nothing)+++> symbolTok :: Maybe String -> Parser String+> symbolTok sym = mytoken (\tok ->+>     case (sym,tok) of+>       (Nothing, L.Symbol p) -> Just p+>       (Just s, L.Symbol p) | s == p -> Just p+>       _ -> Nothing)++> identifierTok :: [String] -> Parser (Maybe (String,String), String)+> identifierTok blackList = mytoken (\tok ->+>     case tok of+>       L.Identifier q p | map toLower p `notElem` blackList -> Just (q,p)+>       _ -> Nothing)++> unquotedIdentifierTok :: [String] -> Maybe String -> Parser String+> unquotedIdentifierTok blackList kw = mytoken (\tok ->+>     case (kw,tok) of+>       (Nothing, L.Identifier Nothing p) | map toLower p `notElem` blackList -> Just p+>       (Just k, L.Identifier Nothing p) | k == map toLower p -> Just p+>       _ -> Nothing)++> mytoken :: (L.Token -> Maybe a) -> Parser a+> mytoken test = token showToken posToken testToken+>   where+>     showToken (_,tok)   = show tok+>     posToken  ((a,b,c),_)  = newPos a b c+>     testToken (_,tok)   = test tok++> unsignedInteger :: Parser Integer+> unsignedInteger = read <$> sqlNumberTok True <?> "natural number"++todo: work out the symbol parsing better++> symbol :: String -> Parser String+> symbol s = symbolTok (Just s) <?> s++> singleCharSymbol :: Char -> Parser Char+> singleCharSymbol c = c <$ symbol [c]++> questionMark :: Parser Char+> questionMark = singleCharSymbol '?' <?> "question mark"++> openParen :: Parser Char+> openParen = singleCharSymbol '('++> closeParen :: Parser Char+> closeParen = singleCharSymbol ')'++> openBracket :: Parser Char+> openBracket = singleCharSymbol '['++> closeBracket :: Parser Char+> closeBracket = singleCharSymbol ']'+++> comma :: Parser Char+> comma = singleCharSymbol ','++> semi :: Parser Char+> semi = singleCharSymbol ';'++= helper functions++> keyword :: String -> Parser String+> keyword k = unquotedIdentifierTok [] (Just k) <?> k++helper function to improve error messages++> keywords_ :: [String] -> Parser ()+> keywords_ ks = mapM_ keyword_ ks <?> intercalate " " ks+++> parens :: Parser a -> Parser a+> parens = between openParen closeParen++> brackets :: Parser a -> Parser a+> brackets = between openBracket closeBracket++> commaSep :: Parser a -> Parser [a]+> commaSep = (`sepBy` comma)++> keyword_ :: String -> Parser ()+> keyword_ = void . keyword++> symbol_ :: String -> Parser ()+> symbol_ = void . symbol++> commaSep1 :: Parser a -> Parser [a]+> commaSep1 = (`sepBy1` comma)++> blacklist :: Dialect -> [String]+> blacklist = 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).++can't work out if aggregate functions are supposed to be reserved or+not, leave them unreserved for now++> reservedWord :: Dialect -> [String]+> reservedWord d | diSyntaxFlavour d == ANSI2011 =+>     ["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+      move this list into the dialect data type++> reservedWord _ = reservedWord ansi2011 ++ ["limit"]++-----------++bit hacky, used to make the dialect available during parsing so+different parsers can be used for different dialects++> type ParseState = Dialect++> type Token = ((String,Int,Int),L.Token)++> type Parser = GenParser Token ParseState++> guardDialect :: [SyntaxFlavour] -> Parser ()+> guardDialect ds = do+>     d <- getState+>     guard (diSyntaxFlavour 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).++The dialect stuff can also be used for custom options: e.g. to only+parse dml for instance.
− 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.lhs view
@@ -1,88 +1,98 @@  > {-# 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+>     ,prettyScalarExpr+>     ,prettyStatement+>     ,prettyStatements >     ) where +#if MIN_VERSION_base(4,11,0)++> import Prelude hiding ((<>))++#endif+ 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 Language.SQL.SimpleSQL.Dialect > import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens, >                          nest, Doc, punctuate, comma, sep, quotes,->                          doubleQuotes, brackets,hcat)+>                          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+> prettyScalarExpr :: Dialect -> ScalarExpr -> String+> prettyScalarExpr d = render . scalarExpr 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)+> -- | Convert a statement ast to concrete syntax.+> prettyStatement :: Dialect -> Statement -> String+> prettyStatement d = render . statement d -= value expressions+> -- | Convert a list of statements to concrete syntax. A semicolon+> -- is inserted after each statement.+> prettyStatements :: Dialect -> [Statement] -> String+> prettyStatements d = render . vcat . map ((<> text ";\n") . statement d) -> valueExpr :: Dialect -> ValueExpr -> Doc-> valueExpr _ (StringLit s) = quotes $ text $ doubleUpQuotes s+= scalar expressions -> valueExpr _ (NumLit s) = text s-> valueExpr _ (IntervalLit s v f t) =+> scalarExpr :: Dialect -> ScalarExpr -> Doc+> scalarExpr _ (StringLit s e t) = text s <> text t <> text e++> scalarExpr _ (NumLit s) = text s+> scalarExpr _ (IntervalLit s v f t) = >     text "interval"->     <+> me (\x -> if x then text "+" else text "-") s+>     <+> me (\x -> text $ case x of+>                              Plus -> "+"+>                              Minus -> "-") 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+> scalarExpr _ (Iden i) = names i+> scalarExpr _ Star = text "*"+> scalarExpr _ Parameter = text "?"+> scalarExpr _ (PositionalArg n) = text $ "$" ++ show n+> scalarExpr _ (HostParameter p i) =+>     text p+>     <+> me (\i' -> text "indicator" <+> text i') i -> valueExpr d (App f es) = names f <> parens (commaSep (map (valueExpr d) es))+> scalarExpr d (App f es) = names f <> parens (commaSep (map (scalarExpr d) es)) -> valueExpr dia (AggregateApp f d es od fil) =+> scalarExpr 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)+>                <+> commaSep (map (scalarExpr dia) es) >                <+> orderBy dia od) >     <+> me (\x -> text "filter"->                   <+> parens (text "where" <+> valueExpr dia x)) fil+>                   <+> parens (text "where" <+> scalarExpr dia x)) fil -> valueExpr d (AggregateAppGroup f es od) =+> scalarExpr d (AggregateAppGroup f es od) = >     names f->     <> parens (commaSep (map (valueExpr d) es))+>     <> parens (commaSep (map (scalarExpr 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)+> scalarExpr d (WindowApp f es pb od fr) =+>     names f <> parens (commaSep $ map (scalarExpr d) es) >     <+> text "over" >     <+> parens ((case pb of >                     [] -> empty >                     _ -> text "partition by"->                           <+> nest 13 (commaSep $ map (valueExpr d) pb))+>                           <+> nest 13 (commaSep $ map (scalarExpr d) pb)) >                 <+> orderBy d od >     <+> me frd fr) >   where@@ -96,72 +106,73 @@ >     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"+>     fpd (Preceding e) = scalarExpr d e <+> text "preceding"+>     fpd (Following e) = scalarExpr 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]+> scalarExpr dia (SpecialOp nm [a,b,c]) | nm `elem` [[Name Nothing "between"]+>                                                  ,[Name Nothing "not between"]] =+>   sep [scalarExpr dia a+>       ,names nm <+> scalarExpr dia b+>       ,nest (length (unnames nm) + 1) $ text "and" <+> scalarExpr dia c] -> valueExpr d (SpecialOp [Name "rowctor"] as) =->     parens $ commaSep $ map (valueExpr d) as+> scalarExpr d (SpecialOp [Name Nothing "rowctor"] as) =+>     parens $ commaSep $ map (scalarExpr d) as -> valueExpr d (SpecialOp nm es) =->   names nm <+> parens (commaSep $ map (valueExpr d) es)+> scalarExpr d (SpecialOp nm es) =+>   names nm <+> parens (commaSep $ map (scalarExpr d) es) -> valueExpr d (SpecialOpK nm fs as) =+> scalarExpr d (SpecialOpK nm fs as) = >     names nm <> parens (sep $ catMaybes->         (fmap (valueExpr d) fs->          : map (\(n,e) -> Just (text n <+> valueExpr d e)) as))+>         (fmap (scalarExpr d) fs+>          : map (\(n,e) -> Just (text n <+> scalarExpr 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"]] =+> scalarExpr d (PrefixOp f e) = names f <+> scalarExpr d e+> scalarExpr d (PostfixOp f e) = scalarExpr d e <+> names f+> scalarExpr d e@(BinOp _ op _) | op `elem` [[Name Nothing "and"]+>                                          ,[Name Nothing "or"]] = >     -- special case for and, or, get all the ands so we can vcat them >     -- nicely >     case ands e of->       (e':es) -> vcat (valueExpr d e'->                        : map ((names op <+>) . valueExpr d) es)+>       (e':es) -> vcat (scalarExpr d e'+>                        : map ((names op <+>) . scalarExpr d) es) >       [] -> empty -- shouldn't be possible >   where >     ands (BinOp a op' b) | op == op' = ands a ++ ands b >     ands x = [x] > -- special case for . we don't use whitespace-> 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+> scalarExpr d (BinOp e0 [Name Nothing "."] e1) =+>     scalarExpr d e0 <> text "." <> scalarExpr d e1+> scalarExpr d (BinOp e0 f e1) =+>     scalarExpr d e0 <+> names f <+> scalarExpr d e1 -> valueExpr dia (Case t ws els) =->     sep $ [text "case" <+> me (valueExpr dia) t]+> scalarExpr dia (Case t ws els) =+>     sep $ [text "case" <+> me (scalarExpr dia) t] >           ++ map w ws >           ++ maybeToList (fmap e els) >           ++ [text "end"] >   where >     w (t0,t1) =->       text "when" <+> nest 5 (commaSep $ map (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 "when" <+> nest 5 (commaSep $ map (scalarExpr dia) t0)+>       <+> text "then" <+> nest 5 (scalarExpr dia t1)+>     e el = text "else" <+> nest 5 (scalarExpr dia el)+> scalarExpr d (Parens e) = parens $ scalarExpr d e+> scalarExpr d (Cast e tn) =+>     text "cast" <> parens (sep [scalarExpr d e >                                ,text "as" >                                ,typeName tn]) -> valueExpr _ (TypedLit tn s) =+> scalarExpr _ (TypedLit tn s) = >     typeName tn <+> quotes (text s) -> valueExpr d (SubQueryExpr ty qe) =+> scalarExpr 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+> scalarExpr d (QuantifiedComparison v c cp sq) =+>     scalarExpr d v >     <+> names c >     <+> (text $ case cp of >              CPAny -> "any"@@ -169,36 +180,36 @@ >              CPAll -> "all") >     <+> parens (queryExpr d sq) -> valueExpr d (Match v u sq) =->     valueExpr d v+> scalarExpr d (Match v u sq) =+>     scalarExpr d v >     <+> text "match" >     <+> (if u then text "unique" else empty) >     <+> parens (queryExpr d sq) -> valueExpr d (In b se x) =->     valueExpr d se <+>+> scalarExpr d (In b se x) =+>     scalarExpr d se <+> >     (if b then empty else text "not") >     <+> text "in" >     <+> parens (nest (if b then 3 else 7) $ >                  case x of->                      InList es -> commaSep $ map (valueExpr d) es+>                      InList es -> commaSep $ map (scalarExpr d) es >                      InQueryExpr qe -> queryExpr d qe) -> valueExpr d (Array v es) =->     valueExpr d v <> brackets (commaSep $ map (valueExpr d) es)+> scalarExpr d (Array v es) =+>     scalarExpr d v <> brackets (commaSep $ map (scalarExpr d) es) -> valueExpr d (ArrayCtor q) =+> scalarExpr d (ArrayCtor q) = >     text "array" <> parens (queryExpr d q) -> valueExpr d (MultisetCtor es) =->     text "multiset" <> brackets (commaSep $ map (valueExpr d) es)+> scalarExpr d (MultisetCtor es) =+>     text "multiset" <> brackets (commaSep $ map (scalarExpr d) es) -> valueExpr d (MultisetQueryCtor q) =+> scalarExpr d (MultisetQueryCtor q) = >     text "multiset" <> parens (queryExpr d q) -> valueExpr d (MultisetBinOp a c q b) =+> scalarExpr d (MultisetBinOp a c q b) = >     sep->     [valueExpr d a+>     [scalarExpr d a >     ,text "multiset" >     ,text $ case c of >                 Union -> "union"@@ -208,56 +219,45 @@ >          SQDefault -> empty >          All -> text "all" >          Distinct -> text "distinct"->     ,valueExpr d b]----> valueExpr _ (CSStringLit cs st) =->   text cs <> quotes (text $ doubleUpQuotes st)+>     ,scalarExpr d b] -> valueExpr d (Escape v e) =->     valueExpr d v <+> text "escape" <+> text [e]+> {-scalarExpr d (Escape v e) =+>     scalarExpr d v <+> text "escape" <+> text [e] -> valueExpr d (UEscape v e) =->     valueExpr d v <+> text "uescape" <+> text [e]+> scalarExpr d (UEscape v e) =+>     scalarExpr d v <+> text "uescape" <+> text [e]-} -> valueExpr d (Collate v c) =->     valueExpr d v <+> text "collate" <+> names c+> scalarExpr d (Collate v c) =+>     scalarExpr d v <+> text "collate" <+> names c -> valueExpr _ (NextValueFor ns) =+> scalarExpr _ (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+> scalarExpr d (VEComment cmt v) =+>     vcat $ map comment cmt ++ [scalarExpr d v] +> scalarExpr _ (OdbcLiteral t s) =+>     text "{" <> lt t <+> quotes (text s) <> text "}"+>   where+>     lt OLDate = text "d"+>     lt OLTime = text "t"+>     lt OLTimestamp = text "ts" +> scalarExpr d (OdbcFunc e) =+>     text "{fn" <+> scalarExpr d e <> text "}"  > unname :: Name -> String-> unname (QName n) = "\"" ++ doubleUpDoubleQuotes n ++ "\""-> unname (UQName n) = "U&\"" ++ doubleUpDoubleQuotes n ++ "\""-> unname (Name n) = n-> unname (DQName s e n) = s ++ n ++ e+> unname (Name Nothing n) = n+> unname (Name (Just (s,e)) n) =+>     s ++ n ++ e  > unnames :: [Name] -> String > unnames ns = intercalate "." $ map unname ns   > name :: Name -> Doc-> name (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+> name (Name Nothing n) = text n+> name (Name (Just (s,e)) n) = text s <> text n <> text e  > names :: [Name] -> Doc > names ns = hcat $ punctuate (text ".") $ map name ns@@ -328,21 +328,21 @@ >           Distinct -> text "distinct" >       ,nest 7 $ sep [selectList dia sl] >       ,from dia fr->       ,maybeValueExpr dia "where" wh+>       ,maybeScalarExpr dia "where" wh >       ,grpBy dia gb->       ,maybeValueExpr dia "having" hv+>       ,maybeScalarExpr dia "having" hv >       ,orderBy dia od->       ,me (\e -> text "offset" <+> valueExpr dia e <+> text "rows") off+>       ,me (\e -> text "offset" <+> scalarExpr 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+>       me (\e -> if diSyntaxFlavour dia == MySQL+>                 then text "limit" <+> scalarExpr dia e+>                 else text "fetch first" <+> scalarExpr dia e >                      <+> text "rows only") fe -> queryExpr dia (CombineQueryExpr q1 ct d c q2) =+> queryExpr dia (QueryExprSetOp q1 ct d c q2) = >   sep [queryExpr dia q1 >       ,text (case ct of >                 Union -> "union"@@ -364,7 +364,7 @@ >            ,queryExpr d qe] > queryExpr d (Values vs) = >     text "values"->     <+> nest 7 (commaSep (map (parens . commaSep . map (valueExpr d)) vs))+>     <+> nest 7 (commaSep (map (parens . commaSep . map (scalarExpr d)) vs)) > queryExpr _ (Table t) = text "table" <+> names t > queryExpr d (QEComment cmt v) = >     vcat $ map comment cmt ++ [queryExpr d v]@@ -375,10 +375,10 @@ >     text "as" <+> name nm >     <+> me (parens . commaSep . map name) cols -> selectList :: Dialect -> [(ValueExpr,Maybe Name)] -> Doc+> selectList :: Dialect -> [(ScalarExpr,Maybe Name)] -> Doc > selectList d is = commaSep $ map si is >   where->     si (e,al) = valueExpr d e <+> me als al+>     si (e,al) = scalarExpr d e <+> me als al >     als al = text "as" <+> name al  > from :: Dialect -> [TableRef] -> Doc@@ -390,7 +390,7 @@ >     tr (TRSimple t) = names t >     tr (TRLateral t) = text "lateral" <+> tr t >     tr (TRFunction f as) =->         names f <> parens (commaSep $ map (valueExpr d) 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@@ -399,6 +399,7 @@ >            ,if b then text "natural" else empty >            ,joinText jt <+> tr t1 >            ,joinCond jc]+>     tr (TROdbc t) = text "{oj" <+> tr t <+> text "}" >     joinText jt = >       sep [case jt of >               JInner -> text "inner"@@ -407,22 +408,22 @@ >               JFull -> text "full" >               JCross -> text "cross" >           ,text "join"]->     joinCond (Just (JoinOn e)) = text "on" <+> valueExpr d e+>     joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr 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+> maybeScalarExpr :: Dialect -> String -> Maybe ScalarExpr -> Doc+> maybeScalarExpr d k = me >       (\e -> sep [text k->                  ,nest (length k + 1) $ valueExpr d e])+>                  ,nest (length k + 1) $ scalarExpr d e])  > grpBy :: Dialect -> [GroupingExpr] -> Doc > grpBy _ [] = empty > grpBy d gs = sep [text "group by" >                ,nest 9 $ commaSep $ map ge gs] >   where->     ge (SimpleGroup e) = valueExpr d e+>     ge (SimpleGroup e) = scalarExpr d e >     ge (GroupingParens g) = parens (commaSep $ map ge g) >     ge (Cube es) = text "cube" <> parens (commaSep $ map ge es) >     ge (Rollup es) = text "rollup" <> parens (commaSep $ map ge es)@@ -434,7 +435,7 @@ >                  ,nest 9 $ commaSep $ map f os] >   where >     f (SortSpec e d n) =->         valueExpr dia e+>         scalarExpr dia e >         <+> (case d of >                   Asc -> text "asc" >                   Desc -> text "desc"@@ -444,6 +445,361 @@ >                 NullsFirst -> text "nulls" <+> text "first" >                 NullsLast -> text "nulls" <+> text "last") += statements++> statement :: Dialect -> Statement -> Doc+++== ddl++> statement _ (CreateSchema nm) =+>     text "create" <+> text "schema" <+> names nm++> statement d (CreateTable nm cds) =+>     text "create" <+> text "table" <+> names nm+>     <+> parens (commaSep $ map cd cds)+>   where+>     cd (TableConstraintDef n con) =+>         maybe empty (\s -> text "constraint" <+> names s) n+>         <+> tableConstraint d con+>     cd (TableColumnDef cd') = columnDef d cd'++> statement d (AlterTable t act) =+>     texts ["alter","table"] <+> names t+>     <+> alterTableAction d act++> statement _ (DropSchema nm db) =+>     text "drop" <+> text "schema" <+> names nm <+> dropBehav db++> statement d (CreateDomain nm ty def cs) =+>     text "create" <+> text "domain" <+> names nm+>     <+> typeName ty+>     <+> maybe empty (\def' -> text "default" <+> scalarExpr d def') def+>     <+> sep (map con cs)+>   where+>     con (cn, e) =+>         maybe empty (\cn' -> text "constraint" <+> names cn') cn+>         <+> text "check" <> parens (scalarExpr d e)++> statement d (AlterDomain nm act) =+>     texts ["alter","domain"]+>     <+> names nm+>     <+> a act+>   where+>     a (ADSetDefault v) = texts ["set","default"] <+> scalarExpr d v+>     a (ADDropDefault) = texts ["drop","default"]+>     a (ADAddConstraint cnm e) =+>         text "add"+>         <+> maybe empty (\cnm' -> text "constraint" <+> names cnm') cnm+>         <+> text "check" <> parens (scalarExpr d e)+>     a (ADDropConstraint cnm) = texts ["drop", "constraint"]+>                                <+> names cnm+++> statement _ (DropDomain nm db) =+>     text "drop" <+> text "domain" <+> names nm <+> dropBehav db++> statement _ (CreateSequence nm sgos) =+>   texts ["create","sequence"] <+> names nm+>   <+> sep (map sequenceGeneratorOption sgos)++> statement _ (AlterSequence nm sgos) =+>   texts ["alter","sequence"] <+> names nm+>   <+> sep (map sequenceGeneratorOption sgos)++> statement _ (DropSequence nm db) =+>     text "drop" <+> text "sequence" <+> names nm <+> dropBehav db+++> statement d (CreateAssertion nm ex) =+>   texts ["create","assertion"] <+> names nm+>   <+> text "check" <+> parens (scalarExpr d ex)++> statement _ (DropAssertion nm db) =+>     text "drop" <+> text "assertion" <+> names nm <+> dropBehav db++== dml++> statement d (SelectStatement q) = queryExpr d q++> statement d (Delete t a w) =+>     text "delete" <+> text "from"+>     <+> names t <+> maybe empty (\x -> text "as" <+> name x) a+>     <+> maybeScalarExpr d "where" w++> statement _ (Truncate t ir) =+>     text "truncate" <+> text "table" <+> names t+>     <+> case ir of+>             DefaultIdentityRestart -> empty+>             ContinueIdentity -> text "continue" <+> text "identity"+>             RestartIdentity -> text "restart" <+> text "identity"++> statement d (Insert t cs s) =+>     text "insert" <+> text "into" <+> names t+>     <+> maybe empty (\cs' -> parens (commaSep $ map name cs')) cs+>     <+> case s of+>             DefaultInsertValues -> text "default" <+> text "values"+>             InsertQuery q -> queryExpr d q++> statement d (Update t a sts whr) =+>     text "update" <+> names t+>     <+> maybe empty (\x -> text "as" <+> name x) a+>     <+> text "set" <+> commaSep (map sc sts)+>     <+> maybeScalarExpr d "where" whr+>   where+>     sc (Set tg v) = names tg <+> text "=" <+> scalarExpr d v+>     sc (SetMultiple ts vs) = parens (commaSep $ map names ts) <+> text "="+>                              <+> parens (commaSep $ map (scalarExpr d) vs)++> statement _ (DropTable n b) =+>     text "drop" <+> text "table" <+> names n <+> dropBehav b++> statement d (CreateView r nm al q co) =+>     text "create" <+> (if r then text "recursive" else empty)+>     <+> text "view" <+> names nm+>     <+> (maybe empty (\al' -> parens $ commaSep $ map name al')) al+>     <+> text "as"+>     <+> queryExpr d q+>     <+> case co of+>             Nothing -> empty+>             Just DefaultCheckOption -> texts ["with", "check", "option"]+>             Just CascadedCheckOption -> texts ["with", "cascaded", "check", "option"]+>             Just LocalCheckOption -> texts ["with", "local", "check", "option"]++> statement _ (DropView n b) =+>     text "drop" <+> text "view" <+> names n <+> dropBehav b+++== transactions++> statement _ StartTransaction =+>     texts ["start", "transaction"]++> statement _ (Savepoint nm) =+>     text "savepoint" <+> name nm++> statement _ (ReleaseSavepoint nm) =+>     texts ["release", "savepoint"] <+> name nm++> statement _ Commit =+>     text "commit"++> statement _ (Rollback mn) =+>     text "rollback"+>     <+> maybe empty (\n -> texts ["to","savepoint"] <+> name n) mn++== access control++> statement _ (GrantPrivilege pas po rs go) =+>     text "grant" <+> commaSep (map privAct pas)+>     <+> text "on" <+> privObj po+>     <+> text "to" <+> commaSep (map name rs)+>     <+> grantOpt go+>   where+>     grantOpt WithGrantOption = texts ["with","grant","option"]+>     grantOpt WithoutGrantOption = empty++> statement _ (GrantRole rs trs ao) =+>     text "grant" <+> commaSep (map name rs)+>     <+> text "to" <+> commaSep (map name trs)+>     <+> adminOpt ao+>   where+>     adminOpt WithAdminOption = texts ["with","admin","option"]+>     adminOpt WithoutAdminOption = empty++> statement _ (CreateRole nm) =+>     texts ["create","role"] <+> name nm++> statement _ (DropRole nm) =+>     texts ["drop","role"] <+> name nm++> statement _ (RevokePrivilege go pas po rs db) =+>     text "revoke"+>     <+> grantOptFor go+>     <+> commaSep (map privAct pas)+>     <+> text "on" <+> privObj po+>     <+> text "from" <+> commaSep (map name rs)+>     <+> dropBehav db+>   where+>     grantOptFor GrantOptionFor = texts ["grant","option","for"]+>     grantOptFor NoGrantOptionFor = empty++> statement _ (RevokeRole ao rs trs db) =+>     text "revoke"+>     <+> adminOptFor ao+>     <+> commaSep (map name rs)+>     <+> text "from" <+> commaSep (map name trs)+>     <+> dropBehav db+>   where+>     adminOptFor AdminOptionFor = texts ["admin","option","for"]+>     adminOptFor NoAdminOptionFor = empty+++> statement _ (StatementComment cs) = vcat $ map comment cs+++== sessions+++== extras++> dropBehav :: DropBehaviour -> Doc+> dropBehav DefaultDropBehaviour = empty+> dropBehav Cascade = text "cascade"+> dropBehav Restrict = text "restrict"+++> columnDef :: Dialect -> ColumnDef -> Doc+> columnDef d (ColumnDef n t mdef cons) =+>       name n <+> typeName t+>       <+> case mdef of+>              Nothing -> empty+>              Just (DefaultClause def) ->+>                  text "default" <+> scalarExpr d def+>              Just (GenerationClause e) ->+>                  texts ["generated","always","as"] <+> parens (scalarExpr d e)+>              Just (IdentityColumnSpec w o) ->+>                  text "generated"+>                  <+> (case w of+>                          GeneratedAlways -> text "always"+>                          GeneratedByDefault -> text "by" <+> text "default")+>                  <+> text "as" <+> text "identity"+>                  <+> (case o of+>                          [] -> empty+>                          os -> parens (sep $ map sequenceGeneratorOption os))+>       <+> sep (map cdef cons)+>   where+>     cdef (ColConstraintDef cnm con) =+>         maybe empty (\s -> text "constraint" <+> names s) cnm+>         <+> pcon con+>     pcon ColNotNullConstraint = texts ["not","null"]+>     pcon ColUniqueConstraint = text "unique"+>     pcon ColPrimaryKeyConstraint = texts ["primary","key"]+>     pcon (ColCheckConstraint v) = text "check" <+> parens (scalarExpr d v)+>     pcon (ColReferencesConstraint tb c m u del) =+>         text "references"+>         <+> names tb+>         <+> maybe empty (\c' -> parens (name c')) c+>         <+> refMatch m+>         <+> refAct "update" u+>         <+> refAct "delete" del++> sequenceGeneratorOption :: SequenceGeneratorOption -> Doc+> sequenceGeneratorOption (SGODataType t) =+>     text "as" <+> typeName t+> sequenceGeneratorOption (SGORestart mi) =+>     text "restart" <+> maybe empty (\mi' -> texts ["with", show mi']) mi+> sequenceGeneratorOption (SGOStartWith i) = texts ["start",  "with", show i]+> sequenceGeneratorOption (SGOIncrementBy i) = texts ["increment", "by", show i]+> sequenceGeneratorOption (SGOMaxValue i) = texts ["maxvalue", show i]+> sequenceGeneratorOption SGONoMaxValue = texts ["no", "maxvalue"]+> sequenceGeneratorOption (SGOMinValue i) = texts ["minvalue", show i]+> sequenceGeneratorOption SGONoMinValue = texts ["no", "minvalue"]+> sequenceGeneratorOption SGOCycle = text "cycle"+> sequenceGeneratorOption SGONoCycle = text "no cycle"++> refMatch :: ReferenceMatch -> Doc+> refMatch m = case m of+>                      DefaultReferenceMatch -> empty+>                      MatchFull -> texts ["match", "full"]+>                      MatchPartial -> texts ["match","partial"]+>                      MatchSimple -> texts ["match", "simple"]++> refAct :: String -> ReferentialAction -> Doc+> refAct t a = case a of+>                      DefaultReferentialAction -> empty+>                      RefCascade -> texts ["on", t, "cascade"]+>                      RefSetNull -> texts ["on", t, "set", "null"]+>                      RefSetDefault -> texts ["on", t, "set", "default"]+>                      RefRestrict -> texts ["on", t, "restrict"]+>                      RefNoAction -> texts ["on", t, "no", "action"]++> alterTableAction :: Dialect -> AlterTableAction -> Doc+> alterTableAction d (AddColumnDef cd) =+>     texts ["add", "column"] <+> columnDef d cd++> alterTableAction d (AlterColumnSetDefault n v) =+>     texts ["alter", "column"]+>     <+> name n+>     <+> texts ["set","default"] <+> scalarExpr d v+> alterTableAction _ (AlterColumnDropDefault n) =+>     texts ["alter", "column"]+>     <+> name n+>     <+> texts ["drop","default"]++> alterTableAction _ (AlterColumnSetNotNull n) =+>     texts ["alter", "column"]+>     <+> name n+>     <+> texts ["set","not","null"]++> alterTableAction _ (AlterColumnDropNotNull n) =+>     texts ["alter", "column"]+>     <+> name n+>     <+> texts ["drop","not","null"]++> alterTableAction _ (AlterColumnSetDataType n t) =+>     texts ["alter", "column"]+>     <+> name n+>     <+> texts ["set","data","Type"]+>     <+> typeName t++> alterTableAction _ (DropColumn n b) =+>     texts ["drop", "column"]+>     <+> name n+>     <+> dropBehav b++> alterTableAction d (AddTableConstraintDef n con) =+>     text "add"+>     <+> maybe empty (\s -> text "constraint" <+> names s) n+>     <+> tableConstraint d con++> alterTableAction _ (DropTableConstraintDef n b) =+>     texts ["drop", "constraint"]+>     <+> names n+>     <+> dropBehav b+++> tableConstraint :: Dialect -> TableConstraint -> Doc+> tableConstraint _ (TableUniqueConstraint ns) =+>          text "unique" <+> parens (commaSep $ map name ns)+> tableConstraint _ (TablePrimaryKeyConstraint ns) =+>         texts ["primary","key"] <+> parens (commaSep $ map name ns)+> tableConstraint _ (TableReferencesConstraint cs t tcs m u del) =+>         texts ["foreign", "key"]+>         <+> parens (commaSep $ map name cs)+>         <+> text "references"+>         <+> names t+>         <+> maybe empty (\c' -> parens (commaSep $ map name c')) tcs+>         <+> refMatch m+>         <+> refAct "update" u+>         <+> refAct "delete" del+> tableConstraint d (TableCheckConstraint v) = text "check" <+> parens (scalarExpr d v)+++> privAct :: PrivilegeAction -> Doc+> privAct PrivAll = texts ["all","privileges"]+> privAct (PrivSelect cs) = text "select" <+> maybeColList cs+> privAct (PrivInsert cs) = text "insert" <+> maybeColList cs+> privAct (PrivUpdate cs) = text "update" <+> maybeColList cs+> privAct (PrivReferences cs) = text "references" <+> maybeColList cs+> privAct PrivDelete = text "delete"+> privAct PrivUsage = text "usage"+> privAct PrivTrigger = text "trigger"+> privAct PrivExecute = text "execute"++> maybeColList :: [Name] -> Doc+> maybeColList cs =+>     if null cs+>     then empty+>     else parens (commaSep $ map name cs)++> privObj :: PrivilegeObject -> Doc+> privObj (PrivTable nm) = names nm+> privObj (PrivDomain nm) = text "domain" <+> names nm+> privObj (PrivType nm) = text "type" <+> names nm+> privObj (PrivSequence nm) = text "sequence" <+> names nm+> privObj (PrivFunction nm) = texts ["specific", "function"] <+> names nm+ = utils  > commaSep :: [Doc] -> Doc@@ -454,3 +810,6 @@  > comment :: Comment -> Doc > comment (BlockComment str) = text "/*" <+> text str <+> text "*/"++> texts :: [String] -> Doc+> texts ts = sep $ map text ts
Language/SQL/SimpleSQL/Syntax.lhs view
@@ -1,12 +1,13 @@ -> -- | The AST for SQL queries.+> -- | The AST for SQL. > {-# LANGUAGE DeriveDataTypeable #-} > module Language.SQL.SimpleSQL.Syntax->     (-- * Value expressions->      ValueExpr(..)+>     (-- * Scalar expressions+>      ScalarExpr(..) >     ,Name(..) >     ,TypeName(..) >     ,IntervalTypeField(..)+>     ,Sign(..) >     ,PrecMultiplier(..) >     ,PrecUnits(..) >     ,SetQuantifier(..)@@ -19,10 +20,11 @@ >     ,Frame(..) >     ,FrameRows(..) >     ,FramePos(..)+>     ,OdbcLiteralType(..) >      -- * Query expressions >     ,QueryExpr(..) >     ,makeSelect->     ,CombineOp(..)+>     ,SetOperatorName(..) >     ,Corresponding(..) >     ,Alias(..) >     ,GroupingExpr(..)@@ -30,18 +32,49 @@ >     ,TableRef(..) >     ,JoinType(..) >     ,JoinCondition(..)->      -- * dialect->     ,Dialect(..)->      -- * comment+>      -- * Statements+>     ,Statement(..)+>     ,DropBehaviour(..)+>     ,IdentityRestart(..)+>     ,InsertSource(..)+>     ,SetClause(..)+>     ,TableElement(..)+>     ,ColumnDef(..)+>     ,DefaultClause(..)+>     ,IdentityWhen(..)+>     ,SequenceGeneratorOption(..)+>     ,ColConstraintDef(..)+>     ,ColConstraint(..)+>     ,TableConstraint(..)+>     ,ReferenceMatch(..)+>     ,ReferentialAction(..)+>     ,AlterTableAction(..)+>     ,CheckOption(..)+>     ,AlterDomainAction(..)+>     ,AdminOption(..)+>     ,GrantOption(..)+>     ,PrivilegeObject(..)+>     ,PrivilegeAction(..)+>     ,AdminOptionFor(..)+>     ,GrantOptionFor(..)+>      -- * Dialects+>     ,Dialect(allowOdbc)+>     ,ansi2011+>     ,mysql+>     ,postgres+>     ,oracle+>     ,sqlserver+>      -- * Comment >     ,Comment(..) >     ) where  > import Data.Data+> import Language.SQL.SimpleSQL.Dialect  > -- | 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+> data ScalarExpr >     = -- | a numeric literal optional decimal point, e+- >       -- integral exponent, e.g >       --@@ -57,37 +90,68 @@ >       -- >       -- * 12.34e-6 >       NumLit String->       -- | string literal, currently only basic strings between->       -- single quotes with a single quote escaped using ''->     | StringLit String+>       -- | string literal, with the start and end quote+>       -- e.g. 'test' -> StringLit "'" "'" "test"+>     | StringLit String String String >       -- | text of interval literal, units of interval precision, >       -- e.g. interval 3 days (3) >     | IntervalLit->       {ilSign :: Maybe Bool -- ^ true if + used, false if - used+>       {ilSign :: Maybe Sign -- ^ if + or - used >       ,ilLiteral :: String -- ^ literal text >       ,ilFrom :: IntervalTypeField >       ,ilTo :: Maybe IntervalTypeField >       }++>       -- | prefix 'typed literal', e.g. int '42'+>     | TypedLit TypeName String+ >       -- | identifier with parts separated by dots >     | Iden [Name] >       -- | star, as in select *, t.*, count(*) >     | Star++>     | Parameter -- ^ Represents a ? in a parameterized query+>     | PositionalArg Int -- ^ Represents an e.g. $1 in a parameterized query+>     | HostParameter String (Maybe String) -- ^ represents a host+>                                           -- parameter, e.g. :a. The+>                                           -- Maybe String is for the+>                                           -- indicator, e.g. :var+>                                           -- indicator :nl+++>       -- | Infix binary operators. This is used for symbol operators+>       -- (a + b), keyword operators (a and b) and multiple keyword+>       -- operators (a is similar to b)+>     | BinOp ScalarExpr [Name] ScalarExpr+>       -- | Prefix unary operators. This is used for symbol+>       -- operators, keyword operators and multiple keyword operators.+>     | PrefixOp [Name] ScalarExpr+>       -- | Postfix unary operators. This is used for symbol+>       -- operators, keyword operators and multiple keyword operators.+>     | PostfixOp [Name] ScalarExpr+>       -- | Used for ternary, mixfix and other non orthodox+>       -- operators. Currently used for row constructors, and for+>       -- between.+>     | SpecialOp [Name] [ScalarExpr]+ >       -- | function application (anything that looks like c style >       -- function application syntactically)->     | App [Name] [ValueExpr]+>     | 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 :: [ValueExpr]-- ^ args+>       ,aggArgs :: [ScalarExpr]-- ^ args >       ,aggOrderBy :: [SortSpec] -- ^ order by->       ,aggFilter :: Maybe ValueExpr -- ^ filter+>       ,aggFilter :: Maybe ScalarExpr -- ^ filter >       } >       -- | aggregates with within group >     | AggregateAppGroup >       {aggName :: [Name] -- ^ aggregate function name->       ,aggArgs :: [ValueExpr] -- ^ args+>       ,aggArgs :: [ScalarExpr] -- ^ args >       ,aggGroup :: [SortSpec] -- ^ within group >       } >       -- | window application, which adds over (partition by a order@@ -95,83 +159,78 @@ >       -- not currently supported >     | WindowApp >       {wnName :: [Name] -- ^ window function name->       ,wnArgs :: [ValueExpr] -- ^ args->       ,wnPartition :: [ValueExpr] -- ^ partition by+>       ,wnArgs :: [ScalarExpr] -- ^ args+>       ,wnPartition :: [ScalarExpr] -- ^ 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)]+>     | SpecialOpK [Name] (Maybe ScalarExpr) [(String,ScalarExpr)]++>       -- | cast(a as typename)+>     | Cast ScalarExpr TypeName+ >       -- | case expression. both flavours supported >     | Case->       {caseTest :: Maybe ValueExpr -- ^ test value->       ,caseWhens :: [([ValueExpr],ValueExpr)] -- ^ when branches->       ,caseElse :: Maybe ValueExpr -- ^ else value+>       {caseTest :: Maybe ScalarExpr -- ^ test value+>       ,caseWhens :: [([ScalarExpr],ScalarExpr)] -- ^ when branches+>       ,caseElse :: Maybe ScalarExpr -- ^ 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++>     | 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 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+>     | In Bool ScalarExpr InPredValue++>       -- | exists, all, any, some subqueries+>     | SubQueryExpr SubQueryExprType QueryExpr+ >     | QuantifiedComparison->             ValueExpr+>             ScalarExpr >             [Name] -- operator >             CompPredQuantifier >             QueryExpr->     | Match ValueExpr Bool -- true if unique++>     | Match ScalarExpr Bool -- true if unique >           QueryExpr->     | Array ValueExpr [ValueExpr] -- ^ represents an array+>     | Array ScalarExpr [ScalarExpr] -- ^ represents an array >                                   -- access expression, or an array ctor >                                   -- e.g. a[3]. The first->                                   -- valueExpr is the array, the+>                                   -- 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)->     | CSStringLit String String->     | Escape ValueExpr Char->     | UEscape ValueExpr Char->     | Collate ValueExpr [Name]->     | MultisetBinOp ValueExpr CombineOp SetQuantifier ValueExpr->     | MultisetCtor [ValueExpr]++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] ValueExpr+>     | VEComment [Comment] ScalarExpr+>     | OdbcLiteral OdbcLiteralType String+>       -- ^ an odbc literal e.g. {d '2000-01-01'}+>     | OdbcFunc ScalarExpr+>       -- ^ an odbc function call e.g. {fn CHARACTER_LENGTH('test')} >       deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents an identifier name, which can be quoted or unquoted.-> 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 "+> -- examples:+> --+> -- * test -> Name Nothing "test"+> -- * "test" -> Name (Just "\"","\"") "test"+> -- * `something` -> Name (Just ("`","`") "something"+> -- * [ms] -> Name (Just ("[","]") "ms"+> data Name = Name (Maybe (String,String)) String >             deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents a type name, used in casts.@@ -192,21 +251,24 @@ > data IntervalTypeField = Itf String (Maybe (Integer, Maybe Integer)) >                          deriving (Eq,Show,Read,Data,Typeable) +> data Sign = Plus | Minus+>             deriving (Eq,Show,Read,Data,Typeable)+ > data PrecMultiplier = PrecK | PrecM | PrecG | PrecT | PrecP >                       deriving (Eq,Show,Read,Data,Typeable) > data PrecUnits = PrecCharacters >                | PrecOctets >                 deriving (Eq,Show,Read,Data,Typeable) -> -- | Used for 'expr in (value expression list)', and 'expr in+> -- | Used for 'expr in (scalar expression list)', and 'expr in > -- (subquery)' syntax.-> data InPredValue = InList [ValueExpr]+> 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 value expression.+> -- | A subquery in a scalar expression. > data SubQueryExprType >     = -- | exists (query expr) >       SqExists@@ -223,7 +285,7 @@ >       deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents one field in an order by list.-> data SortSpec = SortSpec ValueExpr Direction NullsOrder+> data SortSpec = SortSpec ScalarExpr Direction NullsOrder >                 deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents 'nulls first' or 'nulls last' in an order by clause.@@ -245,12 +307,21 @@  > -- | represents the start or end of a frame > data FramePos = UnboundedPreceding->               | Preceding ValueExpr+>               | Preceding ScalarExpr >               | Current->               | Following ValueExpr+>               | 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;@@ -265,7 +336,7 @@ > data QueryExpr >     = Select >       {qeSetQuantifier :: SetQuantifier->       ,qeSelectList :: [(ValueExpr,Maybe Name)]+>       ,qeSelectList :: [(ScalarExpr,Maybe Name)] >        -- ^ the expressions and the column aliases  TODO: consider breaking this up. The SQL grammar has@@ -275,16 +346,16 @@ This would make some things a bit cleaner?  >       ,qeFrom :: [TableRef]->       ,qeWhere :: Maybe ValueExpr+>       ,qeWhere :: Maybe ScalarExpr >       ,qeGroupBy :: [GroupingExpr]->       ,qeHaving :: Maybe ValueExpr+>       ,qeHaving :: Maybe ScalarExpr >       ,qeOrderBy :: [SortSpec]->       ,qeOffset :: Maybe ValueExpr->       ,qeFetchFirst :: Maybe ValueExpr+>       ,qeOffset :: Maybe ScalarExpr+>       ,qeFetchFirst :: Maybe ScalarExpr >       }->     | CombineQueryExpr+>     | QueryExprSetOp >       {qe0 :: QueryExpr->       ,qeCombOp :: CombineOp+>       ,qeCombOp :: SetOperatorName >       ,qeSetQuantifier :: SetQuantifier >       ,qeCorresponding :: Corresponding >       ,qe1 :: QueryExpr@@ -293,7 +364,7 @@ >       {qeWithRecursive :: Bool >       ,qeViews :: [(Alias,QueryExpr)] >       ,qeQueryExpression :: QueryExpr}->     | Values [[ValueExpr]]+>     | Values [[ScalarExpr]] >     | Table [Name] >     | QEComment [Comment] QueryExpr >       deriving (Eq,Show,Read,Data,Typeable)@@ -335,7 +406,7 @@ > -- | 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)+> 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) @@ -345,7 +416,7 @@ >     | Cube [GroupingExpr] >     | Rollup [GroupingExpr] >     | GroupingSets [GroupingExpr]->     | SimpleGroup ValueExpr+>     | SimpleGroup ScalarExpr >       deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents a entry in the csv of tables in the from clause.@@ -360,9 +431,11 @@ >                 -- | from (query expr) >               | TRQueryExpr QueryExpr >                 -- | from function(args)->               | TRFunction [Name] [ValueExpr]+>               | 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@@ -376,19 +449,289 @@ >                 deriving (Eq,Show,Read,Data,Typeable)  > -- | The join condition.-> data JoinCondition = JoinOn ValueExpr -- ^ on expr+> data JoinCondition = JoinOn ScalarExpr -- ^ 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)+> data Statement =+>     -- ddl+>     CreateSchema [Name]+>   | DropSchema [Name] DropBehaviour+>   | CreateTable [Name] [TableElement]+>   | AlterTable [Name] AlterTableAction+>   | DropTable [Name] DropBehaviour+>   | CreateView Bool [Name] (Maybe [Name])+>         QueryExpr (Maybe CheckOption)+>   | DropView [Name]  DropBehaviour+>   | CreateDomain [Name] TypeName (Maybe ScalarExpr)+>        [(Maybe [Name], ScalarExpr)]+>   | AlterDomain [Name] AlterDomainAction+>   | DropDomain [Name] DropBehaviour +>     -- probably won't do character sets, collations+>     -- and translations because I think they are too far from+>     -- reality+>   {-  | CreateCharacterSet+>   | DropCharacterSet+>   | CreateCollation+>   | DropCollation+>   | CreateTranslation+>   | DropTranslation -}+>   | CreateAssertion [Name] ScalarExpr+>   | DropAssertion [Name] DropBehaviour+>   {-   | CreateTrigger+>   | DropTrigger+>   | CreateType+>   | AlterType+>   | DropType+>     -- routine stuff? TODO+>   | CreateCast+>   | DropCast+>   | CreateOrdering+>   | DropOrdering -}+>     -- transforms+>   | CreateSequence [Name] [SequenceGeneratorOption]+>   | AlterSequence [Name] [SequenceGeneratorOption]+>   | DropSequence [Name] DropBehaviour+>     -- dml+>   | SelectStatement QueryExpr+>   {-    | DeclareCursor+>   | OpenCursor+>   | FetchCursor+>   | CloseCursor+>   | SelectInto -}+>   --   | DeletePositioned+>   | Delete [Name] (Maybe Name) (Maybe ScalarExpr)+>   | Truncate [Name] IdentityRestart+>   | Insert [Name] (Maybe [Name]) InsertSource+>   --  | Merge+>   | Update [Name] (Maybe Name) [SetClause] (Maybe ScalarExpr)+>   {-  | TemporaryTable+>   | FreeLocator+>   | HoldLocator  -}+>     -- access control+>   | GrantPrivilege [PrivilegeAction] PrivilegeObject [Name] GrantOption+>   | GrantRole [Name] [Name] AdminOption+>   | CreateRole Name+>   | DropRole Name+>   | RevokePrivilege GrantOptionFor [PrivilegeAction] PrivilegeObject+>             [Name] DropBehaviour+>   | RevokeRole AdminOptionFor [Name] [Name] DropBehaviour+>     -- transaction management+>   | StartTransaction+>   --  | SetTransaction+>   --  | SetContraints+>   | Savepoint Name+>   | ReleaseSavepoint Name+>   | Commit+>   | Rollback (Maybe Name)+>     -- session+>   {-  | SetSessionCharacteristics+>   | SetSessionAuthorization+>   | SetRole+>   | SetTimeZone+>   | SetCatalog+>   | SetSchema+>   | SetNames+>   | SetTransform+>   | SetCollation -}+>   | StatementComment [Comment]+>     deriving (Eq,Show,Read,Data,Typeable) -> -- | Comment. Useful when generating SQL code programmatically.+> data DropBehaviour =+>     Restrict+>   | Cascade+>   | DefaultDropBehaviour+>     deriving (Eq,Show,Read,Data,Typeable)++> data IdentityRestart =+>     ContinueIdentity+>   | RestartIdentity+>   | DefaultIdentityRestart+>     deriving (Eq,Show,Read,Data,Typeable)++> data InsertSource =+>     InsertQuery QueryExpr+>   | DefaultInsertValues+>     deriving (Eq,Show,Read,Data,Typeable)++> data SetClause =+>     Set [Name] ScalarExpr+>   | SetMultiple [[Name]] [ScalarExpr]+>     deriving (Eq,Show,Read,Data,Typeable)++> data TableElement =+>     TableColumnDef ColumnDef+>   | TableConstraintDef (Maybe [Name]) TableConstraint+>     deriving (Eq,Show,Read,Data,Typeable)++> data ColumnDef = ColumnDef Name TypeName+>        (Maybe DefaultClause)+>        [ColConstraintDef]+>        -- (Maybe CollateClause)+>     deriving (Eq,Show,Read,Data,Typeable)++> data ColConstraintDef =+>     ColConstraintDef (Maybe [Name]) ColConstraint+>       -- (Maybe [ConstraintCharacteristics])+>     deriving (Eq,Show,Read,Data,Typeable)++> data ColConstraint =+>     ColNotNullConstraint+>   | ColUniqueConstraint+>   | ColPrimaryKeyConstraint+>   | ColReferencesConstraint [Name] (Maybe Name)+>        ReferenceMatch+>        ReferentialAction+>        ReferentialAction+>   | ColCheckConstraint ScalarExpr+>     deriving (Eq,Show,Read,Data,Typeable)++> data TableConstraint =+>     TableUniqueConstraint [Name]+>   | TablePrimaryKeyConstraint [Name]+>   | TableReferencesConstraint [Name] [Name] (Maybe [Name])+>        ReferenceMatch+>        ReferentialAction+>        ReferentialAction+>   | TableCheckConstraint ScalarExpr+>     deriving (Eq,Show,Read,Data,Typeable)+++> data ReferenceMatch =+>     DefaultReferenceMatch+>   | MatchFull+>   | MatchPartial+>   | MatchSimple+>     deriving (Eq,Show,Read,Data,Typeable)++> data ReferentialAction =+>     DefaultReferentialAction+>   | RefCascade+>   | RefSetNull+>   | RefSetDefault+>   | RefRestrict+>   | RefNoAction+>     deriving (Eq,Show,Read,Data,Typeable)++> data AlterTableAction =+>     AddColumnDef ColumnDef+>   | AlterColumnSetDefault Name ScalarExpr+>   | AlterColumnDropDefault Name+>   | AlterColumnSetNotNull Name+>   | AlterColumnDropNotNull Name+>   | AlterColumnSetDataType Name TypeName+>   {-  | AlterColumnAlterIdentity+>   | AlterColumnDropIdentity+>   | AlterColumnDropColumnGeneration-}+>   | DropColumn Name DropBehaviour+>   | AddTableConstraintDef (Maybe [Name]) TableConstraint+>   --  | AlterTableConstraintDef+>   | DropTableConstraintDef [Name] DropBehaviour+>     deriving (Eq,Show,Read,Data,Typeable)++> {-data ConstraintCharacteristics =+>     ConstraintCharacteristics+>         ConstraintCheckTime+>         Deferrable+>         ConstraintEnforcement+>     deriving (Eq,Show,Read,Data,Typeable)++> data ConstraintCheckTime =+>     DefaultConstraintCheckTime+>   | InitiallyDeferred+>   | InitiallyImmeditate+>     deriving (Eq,Show,Read,Data,Typeable)++> data Deferrable =+>     DefaultDefferable+>   | Deferrable+>   | NotDeferrable+>     deriving (Eq,Show,Read,Data,Typeable)++> data ConstraintEnforcement =+>     DefaultConstraintEnforcement+>   | Enforced+>   | NotEnforced+>     deriving (Eq,Show,Read,Data,Typeable) -}++> {-data TableConstraintDef+>     deriving (Eq,Show,Read,Data,Typeable) -}++> data DefaultClause =+>      DefaultClause ScalarExpr+>    | IdentityColumnSpec IdentityWhen [SequenceGeneratorOption]+>    | GenerationClause ScalarExpr+>     deriving (Eq,Show,Read,Data,Typeable)++> data IdentityWhen =+>     GeneratedAlways+>   | GeneratedByDefault+>     deriving (Eq,Show,Read,Data,Typeable)++> data SequenceGeneratorOption =+>     SGODataType TypeName+>   | SGOStartWith Integer+>   | SGORestart (Maybe Integer)+>   | SGOIncrementBy Integer+>   | SGOMaxValue Integer+>   | SGONoMaxValue+>   | SGOMinValue Integer+>   | SGONoMinValue+>   | SGOCycle+>   | SGONoCycle+>     deriving (Eq,Show,Read,Data,Typeable)++> data CheckOption =+>     DefaultCheckOption+>   | CascadedCheckOption+>   | LocalCheckOption+>     deriving (Eq,Show,Read,Data,Typeable)++> data AlterDomainAction =+>     ADSetDefault ScalarExpr+>   | ADDropDefault+>   | ADAddConstraint (Maybe [Name]) ScalarExpr+>   | ADDropConstraint [Name]+>     deriving (Eq,Show,Read,Data,Typeable)+++> data AdminOption = WithAdminOption | WithoutAdminOption+>     deriving (Eq,Show,Read,Data,Typeable)++> data GrantOption = WithGrantOption | WithoutGrantOption+>     deriving (Eq,Show,Read,Data,Typeable)++> data AdminOptionFor = AdminOptionFor | NoAdminOptionFor+>     deriving (Eq,Show,Read,Data,Typeable)++> data GrantOptionFor = GrantOptionFor | NoGrantOptionFor+>     deriving (Eq,Show,Read,Data,Typeable)++> data PrivilegeObject =+>       PrivTable [Name]+>     | PrivDomain [Name]+>     | PrivType [Name]+>     | PrivSequence [Name]+>     | PrivFunction [Name]+>     deriving (Eq,Show,Read,Data,Typeable)++> data PrivilegeAction =+>       PrivAll+>     | PrivSelect [Name]+>     | PrivDelete+>     | PrivInsert [Name]+>     | PrivUpdate [Name]+>     | PrivReferences [Name]+>     | PrivUsage+>     | PrivTrigger+>     | PrivExecute+>     deriving (Eq,Show,Read,Data,Typeable)++> -- | Comment. Useful when generating SQL code programmatically. The+> -- parser doesn't produce these. > data Comment = BlockComment String >                deriving (Eq,Show,Read,Data,Typeable)
changelog view
@@ -1,11 +1,49 @@-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.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
simple-sql-parser.cabal view
@@ -1,9 +1,13 @@ name:                simple-sql-parser-version:             0.4.4-synopsis:            A parser for SQL queries+version:             0.5.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@@ -11,7 +15,7 @@ license-file:        LICENSE author:              Jake Wheat maintainer:          jakewheatmail@gmail.com-copyright:           Copyright Jake Wheat 2013, 2014+copyright:           Copyright Jake Wheat 2013, 2014, 2015 category:            Database,Language build-type:          Simple extra-source-files:  README,LICENSE,changelog@@ -22,16 +26,18 @@   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.Parse,+                       Language.SQL.SimpleSQL.Lex,                        Language.SQL.SimpleSQL.Syntax   Other-Modules:       Language.SQL.SimpleSQL.Errors,-                       Language.SQL.SimpleSQL.Combinators+                       Language.SQL.SimpleSQL.Combinators,+                       Language.SQL.SimpleSQL.Dialect   other-extensions:    TupleSections   build-depends:       base >=4 && <5,                        parsec >=3.1 && <3.2,@@ -50,51 +56,82 @@                        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+                       tasty >= 1.1 && < 1.3,+                       tasty-hunit >= 0.9 && < 0.11    Other-Modules:       Language.SQL.SimpleSQL.Pretty,-                       Language.SQL.SimpleSQL.Parser,+                       Language.SQL.SimpleSQL.Parse,+                       Language.SQL.SimpleSQL.Lex,                        Language.SQL.SimpleSQL.Syntax,                        Language.SQL.SimpleSQL.Errors,-                       Language.SQL.SimpleSQL.Combinators+                       Language.SQL.SimpleSQL.Combinators,+                       Language.SQL.SimpleSQL.Dialect -                       --Language.SQL.SimpleSQL.ErrorMessages,+                       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.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+                       Language.SQL.SimpleSQL.ScalarExprs,+                       Language.SQL.SimpleSQL.LexerTests    other-extensions:    TupleSections,DeriveDataTypeable   default-language:    Haskell2010+  ghc-options:         -Wall -threaded++executable SimpleSqlParserTool+  main-is:             SimpleSqlParserTool.lhs+  hs-source-dirs:      .,tools+  Build-Depends:       base >=4 && <5,+                       parsec >=3.1 && <3.2,+                       mtl >=2.1 && <2.3,+                       pretty >= 1.1 && < 1.2,+                       pretty-show >= 1.6 && < 1.10+  other-extensions:    TupleSections,DeriveDataTypeable+  default-language:    Haskell2010   ghc-options:         -Wall+  Other-Modules:       Language.SQL.SimpleSQL.Combinators+                       Language.SQL.SimpleSQL.Dialect+                       Language.SQL.SimpleSQL.Errors+                       Language.SQL.SimpleSQL.Lex+                       Language.SQL.SimpleSQL.Parse+                       Language.SQL.SimpleSQL.Pretty+                       Language.SQL.SimpleSQL.Syntax -executable SQLIndent-  main-is:             SQLIndent.lhs+  if flag(parserexe)+    buildable:         True+  else+    buildable:         False++executable Fixity+  main-is:             Fixity.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+                       pretty >= 1.1 && < 1.2,+                       pretty-show >= 1.6 && < 1.10,+                       tasty >= 1.1 && < 1.3,+                       tasty-hunit >= 0.9 && < 0.11+   other-extensions:    TupleSections,DeriveDataTypeable   default-language:    Haskell2010   ghc-options:         -Wall-  if flag(sqlindent)+  if flag(parserexe)     buildable:         True   else     buildable:         False+
+ tools/Fixity.lhs view
@@ -0,0 +1,702 @@++= Fixity fixups++The point of this code is to be able to take a table of fixity+information for unary and binary operators, then adjust an ast to+match these fixities. The standard way of handling this is handling+fixities at the parsing stage.++For the SQL parser, this is difficult because there is lots of weird+syntax for operators (such as prefix and postfix multiple keyword+operators, between, etc.).++An alterative idea which is used in some places is to parse the tree+regarding all the operators to have the same precedence and left+associativity, then correct the fixity in a pass over the ast after+parsing. Would also like to use this to fix the fixity for the join+trees, and set operations, after parsing them. TODO: anything else?+++Approach++Really not sure how to get this correct. So: lots of testing++Basic testing idea: create an expression, then write down manually how+the expression should parse with correct fixity. Can write down the+expression in concrete syntax, and the correct fixity version using+parens.++Then can parse the expression, fix it, parse the fixed expression,+remove the parens and compare them to make sure they are equal.++Second layer of testing. For each source expression parsed, run it+through a generator which will generate every version of that tree by+choosing all possibilities of fixities on a token by token basis. This+will ensure the fixity fixer is robust. An alternative approach is to+guarantee the parser will produce trees where all the fixities are+known (e.g. unary operators always bind tighter than binary, binary+are all left associative, prefix unary bind tighter than postfix. This+way, the fix code can make some assumptions and have less code. We+will stick with the full general version which is more robust.++Another testing approach is to parse the tree with our non fixity+respecting parser then fix it, and also parse it with a fixity+respecting expression parser, and check the results are the same. This+is difficult with the parsec build expression parser which doesn't+handle nested unary operators, so have to find or write another build+expression parser. We can test the fixer with simple operators (single+symbol prefix, postfix and binary ops) and then use it on the complex+sql ast trees.++Can also try to generate trees ala quickcheck/smallcheck, then check+them with the fixer and the build expression parser.++generate a tree:++start with a term+then roll dice:+  add a prefix+  add a postfix+  do nothing+then roll dice+  add a binary op+  for the second arg, recurse the algo+++algorithm:++consider possible cases:+binop with two binops args+binop with prefix on left+binop with postfix on right+postfix with prefix inside+prefix with postfix inside+postfix with binop inside+prefix with binop inside++write a function to deal with each case and try to compose++Tasks:++write unary op tests: on each other, and with binary ops+figure out how to generate trees+do the step one tests (write the fixity with parens)+check out parsers expression parser+see if can generate trees using smallcheck+try to test these trees against expression parser+  otherwise, generate tree, generate variations, check fixity always+produces same result+++++todo:++1. more tests for unary operators with each other+2. moving unary operators inside and outside binary operators:+   have to think about how this will work in general case+3. ways to generate lots of tests and check them+   -> what about creating a parser which parses to a list of all possible+      parses with different fixities for each operator it sees?+4. ambiguous fixity cases - need position annotation to do these nicely+5. real sql: how to work with a variety of ast nodes+6. plug into simple-sql-parser+7. refactor the simple-sql-parser parsing code+8. simple-sql-parser todo for sqream: add other dml, dialects,+   procedural?+9. testing idea: write big expressions with explicit parens everywhere+   parse this+   remove the parens+   pretty print, then parse and fixfixity to see if same+   then generate all variations of tree as if the fixities are different+     and then fixfixity to check it restores the original+++write fixity tests+write code to do the fixing+add error cases: put it in the either monad to report these++check the descend+then: move to real sql+  different abstract representations of binops, etc.+  what is the best way to deal with this? typeclass? conversion to and+  from a generic tree?++++++can the binops be fixed on their own (precedence and assocativity)+and then the prefix and postfix ops in separate passes++what about a pass which puts the tree into canonical form:+all left associative, all unary ops tight as possible?+then the fixer can be easier?++++++> {-# LANGUAGE DeriveDataTypeable,TupleSections #-}+> import Data.Data++> import Text.Parsec.String (Parser)+> import Text.Parsec (try)+> import Text.Parsec.Char+> import Text.Parsec.Combinator+> import Text.Parsec (parse,ParseError)+> import Control.Applicative ((<|>),many) -- ((<**>),(<$>),(<*), (*>),(<*>), (<$), (<|>), many)+> --import qualified Text.Parsec.String.Expr as E+> import Control.Monad+> --import Data.List (intercalate)+> import Data.Maybe ()+> --import qualified Test.HUnit as H+> --import FunctionsAndTypesForParsing+> import Debug.Trace+> import Text.Show.Pretty+> import Data.List+> import Control.Applicative++> import qualified Test.Tasty as T+> import qualified Test.Tasty.HUnit as H+++> data Expr = BinOp Expr String Expr+>           | PrefOp String Expr+>           | PostOp String Expr+>           | Iden String+>           | Lit String+>           | App String [Expr]+>           | Parens Expr+>             deriving (Eq,Show,Data,Typeable)++--------++quick parser++> parensValue :: Parser Expr+> parensValue = Parens <$> parens valueExpr++> idenApp :: Parser Expr+> idenApp = try $ do+>     i <- identifier+>     guard (i `notElem` ["not", "and", "or", "is"])+>     choice [do+>             args <- parens (commaSep valueExpr)+>             return $ App i args+>            ,return $ Iden i+>            ]++> lit :: Parser Expr+> lit = stringLit <|> numLit+>     where+>       stringLit = Lit <$> lexeme (char '\'' *> manyTill anyChar (char '\''))+>       numLit = do+>         x <- lexeme (many1 digit)+>         let y :: Integer+>             y = read x+>         return $ Lit $ show y++> prefOp :: Parser Expr+> prefOp = sym <|> kw+>    where+>       sym = do+>             let prefOps = ["+", "-"]+>             s <- choice $ map symbol prefOps+>             v <- term+>             return $ PrefOp s v+>       kw = do+>            let prefOps = ["not"]+>            i <- identifier+>            guard (i `elem` prefOps)+>            v <- term+>            return $ PrefOp i v++> postOp :: Parser (Expr -> Expr)+> postOp = try $ do+>     let kws = ["is null"]+>         kwsp = map (\a -> try $ do+>                        let x :: [String]+>                            x = words a+>                        mapM_ keyword_ x+>                        return $ PostOp a+>                        ) kws+>     choice kwsp++> binOp :: Parser (Expr -> Expr -> Expr)+> binOp = symbolBinOp <|> kwBinOp+>   where+>     symbolBinOp = do+>                   let binOps = ["+", "-", "*", "/"]+>                   s <- choice $ map symbol binOps+>                   return $ \a b -> BinOp a s b+>     kwBinOp = do+>               let kwBinOps = ["and", "or"]+>               i <- identifier+>               guard (i `elem` kwBinOps)+>               return $ \a b -> BinOp a i b++> term :: Parser Expr+> term = (parensValue+>        <|> try prefOp+>        <|> idenApp+>        <|> lit)+>        <??*> postOp++> -- (<??>) :: Parser a -> Parser (a -> a) -> Parser a+> -- p <??> q = p <**> option id q++> (<??*>) :: Parser a -> Parser (a -> a) -> Parser a+> p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)++> valueExpr :: Parser Expr+> valueExpr = chainl1 term binOp+++> parens :: Parser a -> Parser a+> parens = between openParen closeParen++> openParen :: Parser Char+> openParen = lexeme $ char '('+> closeParen :: Parser Char+> closeParen = lexeme $ char ')'++> symbol :: String -> Parser String+> symbol s = try $ lexeme $ do+>     u <- many1 (oneOf "<>=+-^%/*!|")+>     guard (s == u)+>     return s++> identifier :: Parser String+> identifier = lexeme ((:) <$> firstChar <*> many nonFirstChar)+>   where+>     firstChar = letter <|> char '_'+>     nonFirstChar = digit <|> firstChar++> keyword :: String -> Parser String+> keyword k = try $ do+>     i <- identifier+>     guard (i == k)+>     return k++> keyword_ :: String -> Parser ()+> keyword_ = void . keyword++> whitespace :: Parser ()+> whitespace =+>     choice [simpleWhitespace *> whitespace+>            ,lineComment *> whitespace+>            ,blockComment *> whitespace+>            ,return ()]+>   where+>     lineComment = try (string "--")+>                   *> manyTill anyChar (void (char '\n') <|> eof)+>     blockComment = try (string "/*")+>                    *> manyTill anyChar (try $ string "*/")+>     simpleWhitespace = void $ many1 (oneOf " \t\n")+> lexeme :: Parser a -> Parser a+> lexeme p = p <* whitespace+> comma :: Parser Char+> comma = lexeme $ char ','++> commaSep :: Parser a -> Parser [a]+> commaSep = (`sepBy` comma)++> parseExpr :: String -> Either ParseError Expr+> parseExpr = parse (whitespace *> valueExpr <* eof) ""++--------------++> data Assoc = AssocLeft | AssocRight | AssocNone deriving (Eq,Show)++> type Fixities = [(String, (Int, Assoc))]++> fixFixity :: Fixities -> Expr -> Expr+> fixFixity fixities = fixBinOpPrecedence . fixBinOpAssociativity . fixNestedPrefPostPrec+>   where+>     fixBinOpAssociativity e = case e of+>         BinOp a op b ->+>             let a' = fixBinOpAssociativity a+>                 b' = fixBinOpAssociativity b+>                 def = BinOp a' op b'+>             in case (a',b') of+>                 -- both+>                 -- a1 op1 a2 op b1 op2 b2+>                 (BinOp a1 op1 a2+>                  ,BinOp b1 op2 b2)+>                   | Just (_p,opa) <- lookupFixity op+>                   , Just (_p,op1a) <- lookupFixity op1+>                   , Just (_p,op2a) <- lookupFixity op2+>                   -> case (opa, op1a, op2a) of+>                        (AssocRight, AssocRight, AssocRight) ->+>                            BinOp a1 op1 (BinOp a2 op (BinOp b1 op2 b2))+>                        (AssocLeft, AssocLeft, AssocLeft) ->+>                            BinOp (BinOp (BinOp a1 op1 a2) op b1) op2 b2+>                        --todo: other cases+>                        _ -> def+>                 -- just left side+>                 (BinOp a1 op1 a2, _)+>                 -- a1 op1 a2 op b'+>                   | Just (_p,opa) <- lookupFixity op+>                   , Just (_p,op1a) <- lookupFixity op1+>                   -> case (opa, op1a) of+>                        (AssocRight, AssocRight) ->+>                            BinOp a1 op1 (BinOp a2 op b')+>                        (AssocLeft, AssocLeft) ->+>                            BinOp (BinOp a1 op1 a2) op b'+>                        _ -> def++>                 -- just right side+>                 (_, BinOp b1 op2 b2)+>                 -- e op b1 op2 b2+>                   | Just (_p,opa) <- lookupFixity op+>                   , Just (_p,op2a) <- lookupFixity op2+>                   -> case (opa, op2a) of+>                        (AssocRight, AssocRight) ->+>                            BinOp a' op (BinOp b1 op2 b2)+>                        (AssocLeft, AssocLeft) ->+>                            BinOp (BinOp a' op b1) op2 b2+>                        _ -> def+>                 _ -> def+>         _ -> e++>     fixBinOpPrecedence e = case e of+>         BinOp a op b ->+>             let a' = fixBinOpPrecedence a+>                 b' = fixBinOpPrecedence b+>                 def = BinOp a' op b'+>             in case (a',b') of+>                 -- both+>                 -- a1 op1 a2 op b1 op2 b2+>                 -- all equal+>                 -- p > or < p1 == p2+>                 -- p == p1 < or > p2+>                 (BinOp a1 op1 a2+>                  ,BinOp b1 op2 b2)+>                   | Just (p,_opa) <- lookupFixity op+>                   , Just (p1,_op1a) <- lookupFixity op1+>                   , Just (p2,_op2a) <- lookupFixity op2+>                   -> case () of+>                         -- _ | trace ("both prec " ++ show (p,p1,p2)) False -> undefined+>                         _ | p == p1 && p1 == p2 -> def+>                         _ | p > p1 && p1 == p2 -> BinOp a1 op1 b'+>                         _ | p < p1 && p1 == p2 -> BinOp (BinOp a1 op1 a2) op b'+>                         _ | p == p1 && p2 > p1 -> BinOp a' op (BinOp b1 op2 b2)+>                         _ | p == p1 && p2 < p1 -> def -- todo+>                         _ | otherwise -> def+>                 -- just left side+>                 (BinOp a1 op1 a2, _)+>                 -- a1 op1 a2 op b'+>                   | Just (p,_opa) <- lookupFixity op+>                   , Just (p1,_op1a) <- lookupFixity op1+>                   -> case () of+>                         --  _ | trace ("left prec " ++ show (p,p1)) False -> undefined+>                         _ | p < p1 -> {-trace "b1" $ -}BinOp (BinOp a1 op1 a2) op b'+>                           | p > p1 -> {-trace "b2" $ -}BinOp a1 op1 (BinOp a2 op b')+>                           | otherwise -> def++>                 -- just right side+>                 (_, BinOp b1 op2 b2)+>                 -- a' op b1 op2 b2+>                   | Just (p,_opa) <- lookupFixity op+>                   , Just (p2,_op1a) <- lookupFixity op2+>                   -> case () of+>                         --  _ | trace ("right prec " ++ show (p,p2)) False -> undefined+>                         _ | p > p2 -> {-trace "b1" $ -}BinOp (BinOp a' op b1) op2 b2+>                           | p < p2 -> {-trace "b2" $ -}BinOp a' op (BinOp b1 op2 b2)+>                           | otherwise -> {-trace "def" $ -} def+>                 _ -> def+>         _ -> e++>     fixNestedPrefPostPrec e = case e of+>         PrefOp op a ->+>             let a' = fixNestedPrefPostPrec a+>             in case a' of+>                  PostOp op1 b | Just (p,_) <- lookupFixity op+>                               , Just (p1,_) <- lookupFixity op1+>                               , p > p1 -> PostOp op1 (PrefOp op b)+>                  _ -> PrefOp op a'+>         PostOp op a ->+>             let a' = fixNestedPrefPostPrec a+>             in case a' of+>                  PrefOp op1 b | Just (p,_) <- lookupFixity op+>                               , Just (p1,_) <- lookupFixity op1+>                               , p > p1 -> PrefOp op1 (PostOp op b)+>                  _ -> PostOp op a'+>         _ -> e++++>     lookupFixity :: String -> Maybe (Int,Assoc)+>     lookupFixity s = maybe (trace ("didn't find " ++ s ++ "\n" ++ ppShow fixities) Nothing)+>                      Just $ lookup s fixities+++> sqlFixity :: [(String, (Int, Assoc))]+> sqlFixity = [(".", (13, AssocLeft))+>             ,("[]", (12, AssocNone))++unary + -+todo: split the fixity table into prefix, binary and postfix++todo: don't have explicit precedence numbers in the table??++>             ,("^", (10, AssocNone))]+>             ++ m ["*", "/", "%"] (9, AssocLeft)+>             ++ m ["+","-"] (8, AssocLeft)+>             ++ m ["<", ">", "=", "<=", ">=", "<>"] (4, AssocNone)+>             ++ [("is null", (3, AssocNone))+>                ,("not", (2, AssocRight))+>                ,("and", (1, AssocLeft))+>                ,("or", (0, AssocLeft))]++>   where+>     m l a = map (,a) l++-------++some simple parser tests++> data Test = Group String [Test]+>           | ParserTest String Expr+>           | FixityTest Fixities Expr Expr++> parserTests :: Test+> parserTests = Group "parserTests" $ map (uncurry ParserTest) $+>     [("a", Iden "a")+>     ,("'test'", Lit "test")+>     ,("34", Lit "34")+>     ,("f()", App "f" [])+>     ,("f(3)", App "f" [Lit "3"])+>     ,("(7)", Parens (Lit "7"))+>     ,("a + 3", BinOp (Iden "a") "+" (Lit "3"))+>     ,("1 + 2 + 3", BinOp (BinOp (Lit "1") "+" (Lit "2")) "+" (Lit "3"))++>     ,("a or b", BinOp (Iden "a") "or" (Iden "b"))+>     ,("-1", PrefOp "-" (Lit "1"))+>     ,("not a", PrefOp "not" (Iden "a"))+>     ,("not not a", PrefOp "not" (PrefOp "not" (Iden "a")))+>     ,("a is null", PostOp "is null" (Iden "a"))+>     ,("a is null is null", PostOp "is null" (PostOp "is null" (Iden "a")))+>     ,("-a+3", BinOp (PrefOp "-" (Iden "a")) "+" (Lit "3"))+>     ,("a is null and b is null", BinOp (PostOp "is null" (Iden "a"))+>                                  "and"+>                                  (PostOp "is null" (Iden "b")))+>     ]++> makeParserTest :: String -> Expr -> T.TestTree+> makeParserTest s e = H.testCase s $ do+>     let a = parseExpr s+>     if (Right e == a)+>        then putStrLn $ s ++ " OK"+>        else putStrLn $ "bad parse " ++ s ++ " " ++ show a++------++fixity checks++test cases:+++> fixityTests :: Test+> fixityTests = Group "fixityTests" $+>      map (\(f,s,e) -> FixityTest f s e) $+>      [++2 bin ops wrong associativity left + null versions++>      (sqlFixity+>      ,i "a" `plus` (i "b" `plus` i "c")+>      ,(i "a" `plus` i "b") `plus` i "c")+>     ,(sqlFixity+>      ,(i "a" `plus` i "b") `plus` i "c"+>      ,(i "a" `plus` i "b") `plus` i "c")++2 bin ops wrong associativity right++>     ,(timesRight+>      ,i "a" `times` (i "b" `times` i "c")+>      ,i "a" `times` (i "b" `times` i "c"))+>     ,(timesRight+>      ,(i "a" `times` i "b") `times` i "c"+>      ,i "a" `times` (i "b" `times` i "c"))+++2 bin ops wrong precedence left++>     ,(sqlFixity+>      ,i "a" `plus` (i "b" `times` i "c")+>      ,i "a" `plus` (i "b" `times` i "c"))++>     ,(sqlFixity+>      ,(i "a" `plus` i "b") `times` i "c"+>      ,i "a" `plus` (i "b" `times` i "c"))++2 bin ops wrong precedence right++>     ,(sqlFixity+>      ,(i "a" `times` i "b") `plus` i "c"+>      ,(i "a" `times` i "b") `plus` i "c")++>     ,(sqlFixity+>      ,i "a" `times` (i "b" `plus` i "c")+>      ,(i "a" `times` i "b") `plus` i "c")++a + b * c + d+a * b + c * d++check all variations++>     ] +++>       (let t = (i "a" `plus` i "b")+>                `times`+>                (i "c" `plus` i "d")+>            trs = generateTrees $ splitTree t+>        in [(sqlFixity, x+>            ,i "a" `plus` (i "b" `times` i "c")+>             `plus` i "d")+>           | x <- trs])+>       +++>       (let t = (i "a" `times` i "b")+>                `plus`+>                (i "c" `times` i "d")+>            trs = generateTrees $ splitTree t+>        in [(sqlFixity, x+>            ,(i "a" `times` i "b")+>                `plus`+>                (i "c" `times` i "d"))+>           | x <- trs])+++>     ++ [++prefix then postfix wrong precedence++>      ([("+", (9, AssocNone))+>       ,("is null", (3, AssocNone))]+>      ,PrefOp "+" (PostOp "is null" (i "a"))+>      ,PostOp "is null" (PrefOp "+" (i "a")))++>     ,([("+", (9, AssocNone))+>       ,("is null", (3, AssocNone))]+>      ,PostOp "is null" (PrefOp "+" (i "a"))+>      ,PostOp "is null" (PrefOp "+" (i "a")))++>     ,([("+", (3, AssocNone))+>       ,("is null", (9, AssocNone))]+>      ,PrefOp "+" (PostOp "is null" (i "a"))+>      ,PrefOp "+" (PostOp "is null" (i "a")))++>     ,([("+", (3, AssocNone))+>       ,("is null", (9, AssocNone))]+>      ,PostOp "is null" (PrefOp "+" (i "a"))+>      ,PrefOp "+" (PostOp "is null" (i "a")))++3-way unary operator movement:+take a starting point and generate variations++postfix on first arg of binop (cannot move) make sure precedence wants+  it to move++prefix on second arg of binop (cannot move)++prefix on binop, precedence wrong+postfix on binop precedence wrong+prefix on first arg of binop, precedence wrong+postfix on second arg of binop, precedence wrong++ambiguous fixity tests++sanity check: parens stops rearrangement++check nesting 1 + f(expr)++>     ]+>     where+>       plus a b = BinOp a "+" b+>       times a b = BinOp a "*" b+>       i a = Iden a+>       timesRight = [("*", (9, AssocRight))]++testCase++> makeFixityTest :: Fixities -> Expr -> Expr -> T.TestTree+> makeFixityTest fs s e = H.testCase (show s) $ do+>     let s' = fixFixity fs s+>     H.assertEqual "" s' e+>     {-if (s' == e)+>       then putStrLn $ show s ++ " OK"+>       else putStrLn $ "ERROR\nstart: " ++ show s ++ "\nfixed: " ++ show s' ++ "\nshould be: " ++ show e-}++> tests :: Test+> tests = Group "Tests" [parserTests, fixityTests]++> makeTest :: Test -> T.TestTree+> makeTest (Group n ts) = T.testGroup n $ map makeTest ts+> makeTest (ParserTest s e) = makeParserTest s e+> makeTest (FixityTest f s e) = makeFixityTest f s e++--------++ > tests :: T.TestTree+ > tests = T.testGroup "Tests" $ map makeFixityTest fixityTests++> main :: IO ()+> main = T.defaultMain $ makeTest tests+>   {-do+>        mapM_ checkTest tests+>        mapM_ checkFixity fixityTests+>        let plus a b = BinOp a "+" b+>            times a b = BinOp a "*" b+>            i a = Iden a+>        let t = (i "a" `plus` i "b")+>                `times`+>                (i "c" `plus` i "d")+>            spl = splitTree t+>            trs = generateTrees spl+>        --putStrLn $ "\nSplit\n"+>        --putStrLn $ ppShow (fst spl, length $ snd spl)+>        --putStrLn $ show $ length trs+>        --putStrLn $ "\nTrees\n"+>        --putStrLn $ intercalate "\n" $ map show trs+>        return ()-}++generating trees++1. tree -> list+val op val op val op ...+(has to be two lists?++generate variations:+pick numbers from 0 to n - 1 (n is the number of ops)+choose the op at this position to be the root+recurse on the two sides++> splitTree :: Expr -> ([Expr], [Expr->Expr->Expr])+> splitTree (BinOp a op b) = let (x,y) = splitTree a+>                                (z,w) = splitTree b+>                            in (x++z, y++ [\a b -> BinOp a op b] ++ w)+> splitTree x = ([x],[])++++> generateTrees :: ([Expr], [Expr->Expr->Expr]) -> [Expr]+> generateTrees (es,ops) | length es /= length ops + 1 =+>     error $ "mismatch in lengths " ++ show (length es, length ops)+>     ++"\n" ++ ppShow es ++ "\n"+> generateTrees ([a,b], [op]) = [op a b]+> generateTrees ([a], []) = [a]+> generateTrees (vs, ops) =+>     let n = length ops+>     in --trace ("generating " ++ show (length vs, n) ++ "trees\n") $+>        concat $ flip map [0..n-1] $ \m ->+>          let (v1,v2) = splitAt (m + 1) vs+>              (ops1,op':ops2) = splitAt m ops+>              r = [op' t u | t <- generateTrees (v1,ops1)+>                      , u <- generateTrees (v2,ops2)]+>          in -- trace ("generated " ++ show (length r) ++ " trees")+>             r+> generateTrees ([],[]) = []+++
+ tools/Language/SQL/SimpleSQL/ErrorMessages.lhs view
@@ -0,0 +1,150 @@++Want to work on the error messages. Ultimately, parsec won't give the+best error message for a parser combinator library in haskell. Should+check out the alternatives such as polyparse and uu-parsing.++For now the plan is to try to get the best out of parsec. Skip heavy+work on this until the parser is more left factored?++Ideas:++1. generate large lists of invalid syntax+2. create table of the sql source and the error message+3. save these tables and compare from version to version. Want to+   catch improvements and regressions and investigate. Have to do this+   manually++= generating bad sql source++take good sql statements or expressions. Convert them into sequences+of tokens - want to preserve the whitespace and comments perfectly+here. Then modify these lists by either adding a token, removing a+token, or modifying a token (including creating bad tokens of raw+strings which don't represent anything than can be tokenized.++Now can see the error message for all of these bad strings. Probably+have to generate and prune this list manually in stages since there+will be too many.++Contexts:++another area to focus on is contexts: for instance, we have a set of+e.g. 1000 bad scalar expressions with error messages. Now can put+those bad scalar expressions into various contexts and see that the+error messages are still good.++plan:++1. create a list of all the value expression, with some variations for+   each+2. manually create some error variations for each expression+3. create a renderer which will create a csv of the expressions and+   the errors+   this is to load as a spreadsheet to investigate more+4. create a renderer for the csv which will create a markdown file for+   the website. this is to demonstrate the error messages in the+   documentation++Then create some contexts for all of these: inside another value+expression, or inside a query expression. Do the same: render and+review the error messages.++Then, create some query expressions to focus on the non value+expression parts.+++> module Language.SQL.SimpleSQL.ErrorMessages where++> {-import Language.SQL.SimpleSQL.Parser+> import Data.List+> import Text.Groom++> valueExpressions :: [String]+> valueExpressions =+>     ["10.."+>     ,"..10"+>     ,"10e1e2"+>     ,"10e--3"+>     ,"1a"+>     ,"1%"++>     ,"'b'ad'"+>     ,"'bad"+>     ,"bad'"++>     ,"interval '5' ay"+>     ,"interval '5' day (4.4)"+>     ,"interval '5' day (a)"+>     ,"intervala '5' day"+>     ,"interval 'x' day (3"+>     ,"interval 'x' day 3)"++>     ,"1badiden"+>     ,"$"+>     ,"!"+>     ,"*.a"++>     ,"??"+>     ,"3?"+>     ,"?a"++>     ,"row"+>     ,"row 1,2"+>     ,"row(1,2"+>     ,"row 1,2)"+>     ,"row(1 2)"++>     ,"f("+>     ,"f)"++>     ,"f(a"+>     ,"f a)"+>     ,"f(a b)"++TODO:+case+operators++>    ,"a + (b + c"++casts+subqueries: + whole set of parentheses use+in list+'keyword' functions+aggregates+window functions+++>    ]++> queryExpressions :: [String]+> queryExpressions =+>     map sl1 valueExpressions+>     ++ map sl2 valueExpressions+>     ++ map sl3 valueExpressions+>     +++>     ["select a from t inner jin u"]+>   where+>     sl1 x = "select " ++ x ++ " from t"+>     sl2 x = "select " ++ x ++ ", y from t"+>     sl3 x = "select " ++ x ++ " fom t"++> valExprs :: [String] -> [(String,String)]+> valExprs = map parseOne+>   where+>     parseOne x = let p = parseValueExpr "" Nothing x+>                  in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)+++> queryExprs :: [String] -> [(String,String)]+> queryExprs = map parseOne+>   where+>     parseOne x = let p = parseQueryExpr "" Nothing x+>                  in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)+++> pExprs :: [String] -> [String] -> String+> pExprs x y =+>     let l = valExprs x ++ queryExprs y+>     in intercalate "\n\n\n\n" $ map (\(a,b) -> a ++ "\n" ++ b) l+> -}
tools/Language/SQL/SimpleSQL/FullQueries.lhs view
@@ -8,11 +8,11 @@   > fullQueriesTests :: TestItem-> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr SQL2011))+> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select count(*) from t" >      ,makeSelect->       {qeSelectList = [(App [Name "count"] [Star], Nothing)]->       ,qeFrom = [TRSimple [Name "t"]]+>       {qeSelectList = [(App [Name Nothing "count"] [Star], Nothing)]+>       ,qeFrom = [TRSimple [Name Nothing "t"]] >       } >      ) @@ -23,17 +23,17 @@ >       \  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]+>       {qeSelectList = [(Iden [Name Nothing "a"], Nothing)+>                       ,(App [Name Nothing "sum"]+>                         [BinOp (Iden [Name Nothing "c"])+>                                [Name Nothing "+"] (Iden [Name Nothing "d"])]+>                        ,Just $ Name Nothing "s")]+>       ,qeFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]+>       ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")+>       ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+>       ,qeHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"])+>                                [Name Nothing ">"] (NumLit "5")+>       ,qeOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault] >       } >      ) >     ]
tools/Language/SQL/SimpleSQL/GroupBy.lhs view
@@ -15,21 +15,21 @@ >     ]  > simpleGroupBy :: TestItem-> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr SQL2011))+> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011)) >     [("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"]]+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)+>                                  ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]+>                  ,qeFrom = [TRSimple [Name Nothing "t"]]+>                  ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]] >                  })  >     ,("select a,b,sum(c) from t group by a,b"->      ,makeSelect {qeSelectList = [(Iden [Name "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"]]+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)+>                                  ,(Iden [Name Nothing "b"],Nothing)+>                                  ,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)]+>                  ,qeFrom = [TRSimple [Name Nothing "t"]]+>                  ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]+>                               ,SimpleGroup $ Iden [Name Nothing "b"]] >                  }) >     ] @@ -37,23 +37,23 @@ sure which sql version they were introduced, 1999 or 2003 I think).  > newGroupBy :: TestItem-> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr SQL2011))+> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select * from t group by ()", ms [GroupingParens []]) >     ,("select * from t group by grouping sets ((), (a))" >      ,ms [GroupingSets [GroupingParens []->                        ,GroupingParens [SimpleGroup $ Iden [Name "a"]]]])+>                        ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]]) >     ,("select * from t group by cube(a,b)"->      ,ms [Cube [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]])+>      ,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]]) >     ,("select * from t group by rollup(a,b)"->      ,ms [Rollup [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]])+>      ,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]]) >     ] >   where >     ms g = makeSelect {qeSelectList = [(Star,Nothing)]->                       ,qeFrom = [TRSimple [Name "t"]]+>                       ,qeFrom = [TRSimple [Name Nothing "t"]] >                       ,qeGroupBy = g}  > randomGroupBy :: TestItem-> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr SQL2011)+> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011) >     ["select * from t GROUP BY a" >     ,"select * from t GROUP BY GROUPING SETS((a))" >     ,"select * from t GROUP BY a,b,c"
+ tools/Language/SQL/SimpleSQL/LexerTests.lhs view
@@ -0,0 +1,335 @@+++Test for the lexer++> module Language.SQL.SimpleSQL.LexerTests (lexerTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Lex (Token(..),tokenListWillPrintAndLex)+> --import Debug.Trace+> --import Data.Char (isAlpha)+> import Data.List++> lexerTests :: TestItem+> lexerTests = Group "lexerTests" $+>     [Group "lexer token tests" [ansiLexerTests+>                                ,postgresLexerTests+>                                ,sqlServerLexerTests+>                                ,oracleLexerTests+>                                ,mySqlLexerTests+>                                ,odbcLexerTests]]++> ansiLexerTable :: [(String,[Token])]+> ansiLexerTable =+>     -- single char symbols+>     map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()"+>     -- multi char symbols+>     ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"]+>     ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]+>         -- simple identifiers+>         in map (\i -> (i, [Identifier Nothing i])) idens+>            ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens+>            -- todo: in order to make lex . pretty id, need to+>            -- preserve the case of the u+>            ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens+>            -- host param+>            ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens+>        )+>     -- quoted identifiers with embedded double quotes+>     -- the lexer doesn't unescape the quotes+>     ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]+>     -- strings+>     -- the lexer doesn't apply escapes at all+>     ++ [("'string'", [SqlString "'" "'" "string"])+>        ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])+>        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])+>        ,("'\n'", [SqlString "'" "'" "\n"])]+>     -- csstrings+>     ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))+>        ["n", "N","b", "B","x", "X", "u&"]+>     -- numbers+>     ++ [("10", [SqlNumber "10"])+>        ,(".1", [SqlNumber ".1"])+>        ,("5e3", [SqlNumber "5e3"])+>        ,("5e+3", [SqlNumber "5e+3"])+>        ,("5e-3", [SqlNumber "5e-3"])+>        ,("10.2", [SqlNumber "10.2"])+>        ,("10.2e7", [SqlNumber "10.2e7"])]+>     -- whitespace+>     ++ concat [[([a],[Whitespace [a]])+>                ,([a,b], [Whitespace [a,b]])]+>               | a <- " \n\t", b <- " \n\t"]+>     -- line comment+>     ++ map (\c -> (c, [LineComment c]))+>        ["--", "-- ", "-- this is a comment", "-- line com\n"]+>     -- block comment+>     ++ map (\c -> (c, [BlockComment c]))+>        ["/**/", "/* */","/* this is a comment */"+>        ,"/* this *is/ a comment */"+>        ]++> ansiLexerTests :: TestItem+> ansiLexerTests = Group "ansiLexerTests" $+>     [Group "ansi lexer token tests" $ [LexTest ansi2011 s t |  (s,t) <- ansiLexerTable]+>     ,Group "ansi generated combination lexer tests" $+>     [ LexTest ansi2011 (s ++ s1) (t ++ t1)+>     | (s,t) <- ansiLexerTable+>     , (s1,t1) <- ansiLexerTable+>     , tokenListWillPrintAndLex ansi2011 $ t ++ t1++>     ]+>     ,Group "ansiadhoclexertests" $+>        map (uncurry $ LexTest ansi2011)+>        [("", [])+>        ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"])+>        ] +++>        [-- want to make sure this gives a parse error+>         LexFails ansi2011 "*/"+>         -- combinations of pipes: make sure they fail because they could be+>         -- ambiguous and it is really unclear when they are or not, and+>         -- what the result is even when they are not ambiguous+>        ,LexFails ansi2011 "|||"+>        ,LexFails ansi2011 "||||"+>        ,LexFails ansi2011 "|||||"+>        -- another user experience thing: make sure extra trailing+>        -- number chars are rejected rather than attempting to parse+>        -- if the user means to write something that is rejected by this code,+>        -- then they can use whitespace to make it clear and then it will parse+>        ,LexFails ansi2011 "12e3e4"+>        ,LexFails ansi2011 "12e3e4"+>        ,LexFails ansi2011 "12e3e4"+>        ,LexFails ansi2011 "12e3.4"+>        ,LexFails ansi2011 "12.4.5"+>        ,LexFails ansi2011 "12.4e5.6"+>        ,LexFails ansi2011 "12.4e5e7"]+>      ]++todo: lexing tests+do quickcheck testing:+can try to generate valid tokens then check they parse++same as above: can also try to pair tokens, create an accurate+  function to say which ones can appear adjacent, and test++I think this plus the explicit lists of tokens like above which do+basic sanity + explicit edge casts will provide a high level of+assurance.++++> postgresLexerTable :: [(String,[Token])]+> postgresLexerTable =+>     -- single char symbols+>     map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;():"+>     -- multi char symbols+>     ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]+>     -- generic symbols++>     ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]+>         -- simple identifiers+>         in map (\i -> (i, [Identifier Nothing i])) idens+>            ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens+>            -- todo: in order to make lex . pretty id, need to+>            -- preserve the case of the u+>            ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens+>            -- host param+>            ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens+>        )+>     -- positional var+>     ++ [("$1", [PositionalArg 1])]+>     -- quoted identifiers with embedded double quotes+>     ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]+>     -- strings+>     ++ [("'string'", [SqlString "'" "'" "string"])+>        ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])+>        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])+>        ,("'\n'", [SqlString "'" "'" "\n"])+>        ,("E'\n'", [SqlString "E'" "'" "\n"])+>        ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])+>        ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])+>        ,("'not this \\' quote", [SqlString "'" "'" "not this \\"+>                                 ,Whitespace " "+>                                 ,Identifier Nothing "quote"])+>        ,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])+>        ,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])+>        ,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])+>        ]+>     -- csstrings+>     ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))+>        ["n", "N","b", "B","x", "X", "u&", "e", "E"]+>     -- numbers+>     ++ [("10", [SqlNumber "10"])+>        ,(".1", [SqlNumber ".1"])+>        ,("5e3", [SqlNumber "5e3"])+>        ,("5e+3", [SqlNumber "5e+3"])+>        ,("5e-3", [SqlNumber "5e-3"])+>        ,("10.2", [SqlNumber "10.2"])+>        ,("10.2e7", [SqlNumber "10.2e7"])]+>     -- whitespace+>     ++ concat [[([a],[Whitespace [a]])+>                ,([a,b], [Whitespace [a,b]])]+>               | a <- " \n\t", b <- " \n\t"]+>     -- line comment+>     ++ map (\c -> (c, [LineComment c]))+>        ["--", "-- ", "-- this is a comment", "-- line com\n"]+>     -- block comment+>     ++ map (\c -> (c, [BlockComment c]))+>        ["/**/", "/* */","/* this is a comment */"+>        ,"/* this *is/ a comment */"+>        ]++An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:+++ - * / < > = ~ ! @ # % ^ & | ` ?++There are a few restrictions on operator names, however:+-- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.++A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:++~ ! @ # % ^ & | ` ?++todo: 'negative' tests+symbol then --+symbol then /*+operators without one of the exception chars+  followed by + or - without whitespace++also: do the testing for the ansi compatibility special cases++> postgresShortOperatorTable :: [(String,[Token])]+> postgresShortOperatorTable =+>     [ (x, [Symbol x]) | x <- someValidPostgresOperators 2]+++> postgresExtraOperatorTable :: [(String,[Token])]+> postgresExtraOperatorTable =+>     [ (x, [Symbol x]) | x <- someValidPostgresOperators 4]+++> someValidPostgresOperators :: Int -> [String]+> someValidPostgresOperators l =+>        [ x+>        | n <- [1..l]+>        , x <- combos "+-*/<>=~!@#%^&|`?" n+>        , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)+>        , not (last x `elem` "+-")+>          || or (map (`elem` x) "~!@#%^&|`?")+>        ]++These are postgres operators, which if followed immediately by a + or+-, will lex as separate operators rather than one operator including+the + or -.++> somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [String]+> somePostgresOpsWhichWontAddTrailingPlusMinus l =+>        [ x+>        | n <- [1..l]+>        , x <- combos "+-*/<>=" n+>        , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)+>        , not (last x `elem` "+-")+>        ]+++> postgresLexerTests :: TestItem+> postgresLexerTests = Group "postgresLexerTests" $+>     [Group "postgres lexer token tests" $+>      [LexTest postgres s t | (s,t) <- postgresLexerTable]+>     ,Group "postgres generated lexer token tests" $+>      [LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]+>     ,Group "postgres generated combination lexer tests" $+>     [ LexTest postgres (s ++ s1) (t ++ t1)+>     | (s,t) <- postgresLexerTable ++ postgresShortOperatorTable+>     , (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable+>     , tokenListWillPrintAndLex postgres $ t ++ t1++>     ]+>     ,Group "generated postgres edgecase lexertests" $+>      [LexTest postgres s t+>      | (s,t) <- edgeCaseCommentOps+>                 ++ edgeCasePlusMinusOps+>                 ++ edgeCasePlusMinusComments]++>     ,Group "adhoc postgres lexertests" $+>       -- need more tests for */ to make sure it is caught if it is in the middle of a+>       -- sequence of symbol letters+>         [LexFails postgres "*/"+>         ,LexFails postgres ":::"+>         ,LexFails postgres "::::"+>         ,LexFails postgres ":::::"+>         ,LexFails postgres "@*/"+>         ,LexFails postgres "-*/"+>         ,LexFails postgres "12e3e4"+>         ,LexFails postgres "12e3e4"+>         ,LexFails postgres "12e3e4"+>         ,LexFails postgres "12e3.4"+>         ,LexFails postgres "12.4.5"+>         ,LexFails postgres "12.4e5.6"+>         ,LexFails postgres "12.4e5e7"+>          -- special case allow this to lex to 1 .. 2+>          -- this is for 'for loops' in plpgsql+>         ,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]+>     ]+>  where+>    edgeCaseCommentOps =+>      [ (x ++ "/*<test*/", [Symbol x, BlockComment "/*<test*/"])+>      | x <- eccops+>      , not (last x == '*')+>      ] +++>      [ (x ++ "--<test", [Symbol x, LineComment "--<test"])+>      | x <- eccops+>      , not (last x == '-')+>      ]+>    eccops = someValidPostgresOperators 2+>    edgeCasePlusMinusOps = concat+>      [ [ (x ++ "+", [Symbol x, Symbol "+"])+>        , (x ++ "-", [Symbol x, Symbol "-"]) ]+>      | x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2+>      ]+>    edgeCasePlusMinusComments =+>      [("---", [LineComment "---"])+>      ,("+--", [Symbol "+", LineComment "--"])+>      ,("-/**/", [Symbol "-", BlockComment "/**/"])+>      ,("+/**/", [Symbol "+", BlockComment "/**/"])+>      ]+++> sqlServerLexerTests :: TestItem+> sqlServerLexerTests = Group "sqlServerLexTests" $+>     [ LexTest sqlserver s t | (s,t) <-+>     [("@variable", [(PrefixedVariable '@' "variable")])+>     ,("#variable", [(PrefixedVariable '#' "variable")])+>     ,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])+>     ]]++> oracleLexerTests :: TestItem+> oracleLexerTests = Group "oracleLexTests" $+>     [] -- nothing oracle specific atm++> mySqlLexerTests :: TestItem+> mySqlLexerTests = Group "mySqlLexerTests" $+>     [ LexTest mysql s t | (s,t) <-+>     [("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])+>     ]+>     ]++> odbcLexerTests :: TestItem+> odbcLexerTests = Group "odbcLexTests" $+>     [ LexTest sqlserver {allowOdbc = True} s t | (s,t) <-+>     [("{}", [Symbol "{", Symbol "}"])+>     ]]+>     ++ [LexFails sqlserver "{"+>        ,LexFails sqlserver "}"]++> combos :: [a] -> Int -> [[a]]+> combos _ 0 = [[]]+> combos l n = [ x:tl | x <- l, tl <- combos l (n - 1) ]++figure out a way to do quickcheck testing:+1. generate valid tokens and check they parse++2. combine two generated tokens together for the combo testing++this especially will work much better for the postgresql extensible+operator tests which doing exhaustively takes ages and doesn't bring+much benefit over testing a few using quickcheck.
tools/Language/SQL/SimpleSQL/MySQL.lhs view
@@ -18,23 +18,23 @@ [LIMIT {[offset,] row_count | row_count OFFSET offset}]  > backtickQuotes :: TestItem-> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestValueExpr MySQL))->     [("`test`", Iden [DQName "`" "`" "test"])+> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))+>     [("`test`", Iden [Name (Just ("`","`")) "test"]) >     ]->     ++ [ParseValueExprFails SQL2011 "`test`"]+>     ++ [ParseScalarExprFails ansi2011 "`test`"] >     )  > limit :: TestItem-> limit = Group "queries" ( map (uncurry (TestQueryExpr MySQL))+> 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"]+>     ++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"+>        ,ParseQueryExprFails ansi2011 "select * from t limit 5"] >     ) >   where >     sel = makeSelect >           {qeSelectList = [(Star, Nothing)]->           ,qeFrom = [TRSimple [Name "t"]]+>           ,qeFrom = [TRSimple [Name Nothing "t"]] >           }
+ tools/Language/SQL/SimpleSQL/Odbc.lhs view
@@ -0,0 +1,52 @@++> module Language.SQL.SimpleSQL.Odbc (odbcTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> odbcTests :: TestItem+> odbcTests = Group "odbc" [+>        Group "datetime" [+>            e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")+>           ,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")+>           ,e "{ts '2000-01-01 12:00:01.1'}"+>                (OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")+>        ]+>        ,Group "functions" [+>              e "{fn CHARACTER_LENGTH(string_exp)}"+>              $ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])+>             ,e "{fn EXTRACT(day from t)}"+>             $ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])+>             ,e "{fn now()}"+>              $ OdbcFunc (ap "now" [])+>             ,e "{fn CONVERT('2000-01-01', SQL_DATE)}"+>              $ OdbcFunc (ap "CONVERT"+>               [StringLit "'" "'" "2000-01-01"+>               ,iden "SQL_DATE"])+>             ,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"+>              $ OdbcFunc (ap "CONVERT"+>               [OdbcFunc (ap "CURDATE" [])+>               ,iden "SQL_DATE"])+>             ]+>        ,Group "outer join" [+>              TestQueryExpr ansi2011 {allowOdbc=True}+>              "select * from {oj t1 left outer join t2 on expr}"+>              $ makeSelect+>                    {qeSelectList = [(Star,Nothing)]+>                    ,qeFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"])+>                                          (Just $ JoinOn $ Iden [Name Nothing "expr"])]}]+>        ,Group "check parsing bugs" [+>              TestQueryExpr ansi2011 {allowOdbc=True}+>              "select {fn CONVERT(cint,SQL_BIGINT)} from t;"+>              $ makeSelect+>                    {qeSelectList = [(OdbcFunc (ap "CONVERT"+>                                                       [iden "cint"+>                                                       ,iden "SQL_BIGINT"]), Nothing)]+>                    ,qeFrom = [TRSimple [Name Nothing "t"]]}]+>        ]+>   where+>     e = TestScalarExpr ansi2011 {allowOdbc = True}+>     --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}+>     ap n = App [Name Nothing n]+>     iden n = Iden [Name Nothing n]+
+ tools/Language/SQL/SimpleSQL/Oracle.lhs view
@@ -0,0 +1,29 @@++Tests for oracle dialect parsing++> module Language.SQL.SimpleSQL.Oracle (oracleTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> oracleTests :: TestItem+> oracleTests = Group "oracle dialect"+>     [oracleLobUnits]+++> oracleLobUnits :: TestItem+> oracleLobUnits = Group "oracleLobUnits" (map (uncurry (TestScalarExpr oracle))+>     [("cast (a as varchar2(3 char))"+>      ,Cast (Iden [Name Nothing "a"]) (+>          PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters)))+>      ,("cast (a as varchar2(3 byte))"+>      ,Cast (Iden [Name Nothing "a"]) (+>          PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecOctets)))+>      ]+>     ++ [TestStatement oracle+>       "create table t (a varchar2(55 BYTE));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a")+>         (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))+>         Nothing []]]+>     )
tools/Language/SQL/SimpleSQL/Postgres.lhs view
@@ -8,7 +8,7 @@ > import Language.SQL.SimpleSQL.TestTypes  > postgresTests :: TestItem-> postgresTests = Group "postgresTests" $ map (ParseQueryExpr SQL2011)+> postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)  lexical syntax section
tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs view
@@ -28,7 +28,7 @@   > duplicates :: TestItem-> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr SQL2011))+> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select a from t" ,ms SQDefault) >     ,("select all a from t" ,ms All) >     ,("select distinct a from t", ms Distinct)@@ -36,90 +36,90 @@ >  where >    ms d = makeSelect >           {qeSetQuantifier = d->           ,qeSelectList = [(Iden [Name "a"],Nothing)]->           ,qeFrom = [TRSimple [Name "t"]]}+>           ,qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>           ,qeFrom = [TRSimple [Name Nothing "t"]]}  > selectLists :: TestItem-> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr SQL2011))+> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select 1", >       makeSelect {qeSelectList = [(NumLit "1",Nothing)]})  >     ,("select a"->      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]})+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]})  >     ,("select a,b"->      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)->                                  ,(Iden [Name "b"],Nothing)]})+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)+>                                  ,(Iden [Name Nothing "b"],Nothing)]})  >     ,("select 1+2,3+4" >      ,makeSelect {qeSelectList =->                      [(BinOp (NumLit "1") [Name "+"] (NumLit "2"),Nothing)->                      ,(BinOp (NumLit "3") [Name "+"] (NumLit "4"),Nothing)]})+>                      [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)+>                      ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]})  >     ,("select a as a, /*comment*/ b as b"->      ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a")->                                  ,(Iden [Name "b"], Just $ Name "b")]})+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")+>                                  ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})  >     ,("select a a, b b"->      ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a")->                                  ,(Iden [Name "b"], Just $ Name "b")]})+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")+>                                  ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})  >     ,("select a + b * c" >      ,makeSelect {qeSelectList =->       [(BinOp (Iden [Name "a"]) [Name "+"]->         (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"]))+>       [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]+>         (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])) >        ,Nothing)]})  >     ]  > whereClause :: TestItem-> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr SQL2011))+> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011)) >     [("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")})+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>                  ,qeFrom = [TRSimple [Name Nothing "t"]]+>                  ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")}) >     ]  > having :: TestItem-> having = Group "having" $ map (uncurry (TestQueryExpr SQL2011))+> having = Group "having" $ map (uncurry (TestQueryExpr ansi2011)) >     [("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")+>      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)+>                                  ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]+>                  ,qeFrom = [TRSimple [Name Nothing "t"]]+>                  ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+>                  ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]])+>                                           [Name Nothing ">"] (NumLit "5") >                  }) >     ]  > orderBy :: TestItem-> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr SQL2011))+> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select a from t order by a"->      ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault])  >     ,("select a from t order by a, b"->      ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault->          ,SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault+>          ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault])  >     ,("select a from t order by a asc"->      ,ms [SortSpec (Iden [Name "a"]) Asc NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name Nothing "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])+>      ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault+>          ,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault])  >     ,("select a from t order by a desc nulls first, b desc nulls last"->      ,ms [SortSpec (Iden [Name "a"]) Desc NullsFirst->          ,SortSpec (Iden [Name "b"]) Desc NullsLast])+>      ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst+>          ,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast])  >     ] >   where->     ms o = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]->                       ,qeFrom = [TRSimple [Name "t"]]+>     ms o = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>                       ,qeFrom = [TRSimple [Name Nothing "t"]] >                       ,qeOrderBy = o}  > offsetFetch :: TestItem-> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr SQL2011))+> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011)) >     [-- ansi standard >      ("select a from t offset 5 rows fetch next 10 rows only" >      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))@@ -136,74 +136,74 @@ >     ] >   where >     ms o l = makeSelect->              {qeSelectList = [(Iden [Name "a"],Nothing)]->              ,qeFrom = [TRSimple [Name "t"]]+>              {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>              ,qeFrom = [TRSimple [Name Nothing "t"]] >              ,qeOffset = o >              ,qeFetchFirst = l}  > combos :: TestItem-> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))+> combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select a from t union select b from u"->      ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)+>      ,QueryExprSetOp ms1 Union SQDefault Respectively ms2)  >     ,("select a from t intersect select b from u"->      ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2)+>      ,QueryExprSetOp ms1 Intersect SQDefault Respectively ms2)  >     ,("select a from t except all select b from u"->      ,CombineQueryExpr ms1 Except All Respectively ms2)+>      ,QueryExprSetOp ms1 Except All Respectively ms2)  >     ,("select a from t union distinct corresponding \ >       \select b from u"->      ,CombineQueryExpr ms1 Union Distinct Corresponding ms2)+>      ,QueryExprSetOp ms1 Union Distinct Corresponding ms2)  >     ,("select a from t union select a from t union select a from t" >      -- TODO: union should be left associative. I think the others also >      -- so this needs to be fixed (new optionSuffix variation which >      -- handles this)->      ,CombineQueryExpr ms1 Union SQDefault Respectively->        (CombineQueryExpr ms1 Union SQDefault Respectively ms1))+>      ,QueryExprSetOp ms1 Union SQDefault Respectively+>        (QueryExprSetOp ms1 Union SQDefault Respectively ms1)) >     ] >   where >     ms1 = makeSelect->           {qeSelectList = [(Iden [Name "a"],Nothing)]->           ,qeFrom = [TRSimple [Name "t"]]}+>           {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>           ,qeFrom = [TRSimple [Name Nothing "t"]]} >     ms2 = makeSelect->           {qeSelectList = [(Iden [Name "b"],Nothing)]->           ,qeFrom = [TRSimple [Name "u"]]}+>           {qeSelectList = [(Iden [Name Nothing "b"],Nothing)]+>           ,qeFrom = [TRSimple [Name Nothing "u"]]}   > withQueries :: TestItem-> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr SQL2011))+> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011)) >     [("with u as (select a from t) select a from u"->      ,With False [(Alias (Name "u") Nothing, ms1)] ms2)+>      ,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2)  >     ,("with u(b) as (select a from t) select a from u"->      ,With False [(Alias (Name "u") (Just [Name "b"]), ms1)] ms2)+>      ,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2)  >     ,("with x as (select a from t),\n\ >       \     u as (select a from x)\n\ >       \select a from u"->      ,With False [(Alias (Name "x") Nothing, ms1), (Alias (Name "u") Nothing,ms3)] ms2)+>      ,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2)  >     ,("with recursive u as (select a from t) select a from u"->      ,With True [(Alias (Name "u") Nothing, ms1)] ms2)+>      ,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2) >     ] >  where >    ms c t = makeSelect->             {qeSelectList = [(Iden [Name c],Nothing)]->             ,qeFrom = [TRSimple [Name t]]}+>             {qeSelectList = [(Iden [Name Nothing c],Nothing)]+>             ,qeFrom = [TRSimple [Name Nothing t]]} >    ms1 = ms "a" "t" >    ms2 = ms "a" "u" >    ms3 = ms "a" "x"  > values :: TestItem-> values = Group "values" $ map (uncurry (TestQueryExpr SQL2011))+> values = Group "values" $ map (uncurry (TestQueryExpr ansi2011)) >     [("values (1,2),(3,4)" >       ,Values [[NumLit "1", NumLit "2"] >               ,[NumLit "3", NumLit "4"]]) >     ]  > tables :: TestItem-> tables = Group "tables" $ map (uncurry (TestQueryExpr SQL2011))->     [("table tbl", Table [Name "tbl"])+> tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))+>     [("table tbl", Table [Name Nothing "tbl"]) >     ]
tools/Language/SQL/SimpleSQL/QueryExprs.lhs view
@@ -8,11 +8,11 @@ > import Language.SQL.SimpleSQL.Syntax  > queryExprsTests :: TestItem-> queryExprsTests = Group "query exprs" $ map (uncurry (TestQueryExprs SQL2011))+> queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011)) >     [("select 1",[ms]) >     ,("select 1;",[ms]) >     ,("select 1;select 1",[ms,ms]) >     ,(" select 1;select 1; ",[ms,ms]) >     ] >   where->     ms = makeSelect {qeSelectList = [(NumLit "1",Nothing)]}+>     ms = SelectStatement $ 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/SQL2011AccessControl.lhs view
@@ -0,0 +1,315 @@++Section 12 in Foundation++grant, etc+++> module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> sql2011AccessControlTests :: TestItem+> sql2011AccessControlTests = Group "sql 2011 access control tests" [++12 Access control++12.1 <grant statement>++<grant statement> ::=+    <grant privilege statement>+  | <grant role statement>++12.2 <grant privilege statement>++<grant privilege statement> ::=+  GRANT <privileges> TO <grantee> [ { <comma> <grantee> }... ]+      [ WITH HIERARCHY OPTION ]+      [ WITH GRANT OPTION ]+      [ GRANTED BY <grantor> ]++12.3 <privileges>+<privileges> ::=+  <object privileges> ON <object name>++<object name> ::=+      [ TABLE ] <table name>+  |   DOMAIN <domain name>+  |   COLLATION <collation name>+  |   CHARACTER SET <character set name>+  |   TRANSLATION <transliteration name>+  |   TYPE <schema-resolved user-defined type name>+  |   SEQUENCE <sequence generator name>+  |   <specific routine designator>++<object privileges> ::=+    ALL PRIVILEGES+  | <action> [ { <comma> <action> }... ]++<action> ::=+    SELECT+  | SELECT <left paren> <privilege column list> <right paren>+  | SELECT <left paren> <privilege method list> <right paren>+  | DELETE+  | INSERT [ <left paren> <privilege column list> <right paren> ]+  | UPDATE [ <left paren> <privilege column list> <right paren> ]+  | REFERENCES [ <left paren> <privilege column list> <right paren> ]+  | USAGE+  | TRIGGER+  | UNDER+  | EXECUTE++<privilege method list> ::=+  <specific routine designator> [ { <comma> <specific routine designator> }... ]++<privilege column list> ::=+  <column name list>++<grantee> ::=+    PUBLIC+  | <authorization identifier>++<grantor> ::=+    CURRENT_USER+  | CURRENT_ROLE++>      (TestStatement ansi2011+>       "grant all privileges on tbl1 to role1"+>      $ GrantPrivilege [PrivAll]+>        (PrivTable [Name Nothing "tbl1"])+>        [Name Nothing "role1"] WithoutGrantOption)+++>     ,(TestStatement ansi2011+>       "grant all privileges on tbl1 to role1,role2"+>      $ GrantPrivilege [PrivAll]+>        (PrivTable [Name Nothing "tbl1"])+>        [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant all privileges on tbl1 to role1 with grant option"+>      $ GrantPrivilege [PrivAll]+>        (PrivTable [Name Nothing "tbl1"])+>        [Name Nothing "role1"] WithGrantOption)++>     ,(TestStatement ansi2011+>       "grant all privileges on table tbl1 to role1"+>      $ GrantPrivilege [PrivAll]+>        (PrivTable [Name Nothing "tbl1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant all privileges on domain mydom to role1"+>      $ GrantPrivilege [PrivAll]+>        (PrivDomain [Name Nothing "mydom"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant all privileges on type t1 to role1"+>      $ GrantPrivilege [PrivAll]+>        (PrivType [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant all privileges on sequence s1 to role1"+>      $ GrantPrivilege [PrivAll]+>        (PrivSequence [Name Nothing "s1"])+>        [Name Nothing "role1"] WithoutGrantOption)+++>     ,(TestStatement ansi2011+>       "grant select on table t1 to role1"+>      $ GrantPrivilege [PrivSelect []]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant select(a,b) on table t1 to role1"+>      $ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant delete on table t1 to role1"+>      $ GrantPrivilege [PrivDelete]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant insert on table t1 to role1"+>      $ GrantPrivilege [PrivInsert []]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant insert(a,b) on table t1 to role1"+>      $ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant update on table t1 to role1"+>      $ GrantPrivilege [PrivUpdate []]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant update(a,b) on table t1 to role1"+>      $ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant references on table t1 to role1"+>      $ GrantPrivilege [PrivReferences []]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant references(a,b) on table t1 to role1"+>      $ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant usage on table t1 to role1"+>      $ GrantPrivilege [PrivUsage]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant trigger on table t1 to role1"+>      $ GrantPrivilege [PrivTrigger]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)+++>     ,(TestStatement ansi2011+>       "grant execute on specific function f to role1"+>      $ GrantPrivilege [PrivExecute]+>        (PrivFunction [Name Nothing "f"])+>        [Name Nothing "role1"] WithoutGrantOption)++>     ,(TestStatement ansi2011+>       "grant select,delete on table t1 to role1"+>      $ GrantPrivilege [PrivSelect [], PrivDelete]+>        (PrivTable [Name Nothing "t1"])+>        [Name Nothing "role1"] WithoutGrantOption)++skipping for now:++what is 'under' action?++collation, character set, translation, member thing, methods++for review++some pretty big things missing in the standard:++schema, database++functions, etc., by argument types since they can be overloaded++++12.4 <role definition>++<role definition> ::=+  CREATE ROLE <role name> [ WITH ADMIN <grantor> ]++>     ,(TestStatement ansi2011+>       "create role rolee"+>      $ CreateRole (Name Nothing "rolee"))+++12.5 <grant role statement>++<grant role statement> ::=+  GRANT <role granted> [ { <comma> <role granted> }... ]+      TO <grantee> [ { <comma> <grantee> }... ]+      [ WITH ADMIN OPTION ]+      [ GRANTED BY <grantor> ]++<role granted> ::=+  <role name>++>     ,(TestStatement ansi2011+>       "grant role1 to public"+>      $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)++>     ,(TestStatement ansi2011+>       "grant role1,role2 to role3,role4"+>      $ GrantRole [Name Nothing "role1",Name Nothing "role2"]+>                  [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)++>     ,(TestStatement ansi2011+>       "grant role1 to role3 with admin option"+>      $ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)+++12.6 <drop role statement>++<drop role statement> ::=+  DROP ROLE <role name>++>     ,(TestStatement ansi2011+>       "drop role rolee"+>      $ DropRole (Name Nothing "rolee"))+++12.7 <revoke statement>++<revoke statement> ::=+    <revoke privilege statement>+  | <revoke role statement>++<revoke privilege statement> ::=+  REVOKE [ <revoke option extension> ] <privileges>+      FROM <grantee> [ { <comma> <grantee> }... ]+      [ GRANTED BY <grantor> ]+      <drop behavior>++<revoke option extension> ::=+    GRANT OPTION FOR+  | HIERARCHY OPTION FOR+++>     ,(TestStatement ansi2011+>       "revoke select on t1 from role1"+>      $ RevokePrivilege NoGrantOptionFor [PrivSelect []]+>               (PrivTable [Name Nothing "t1"])+>               [Name Nothing "role1"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "revoke grant option for select on t1 from role1,role2 cascade"+>      $ RevokePrivilege GrantOptionFor [PrivSelect []]+>                        (PrivTable [Name Nothing "t1"])+>               [Name Nothing "role1",Name Nothing "role2"] Cascade)+++<revoke role statement> ::=+  REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]+      FROM <grantee> [ { <comma> <grantee> }... ]+      [ GRANTED BY <grantor> ]+      <drop behavior>++<role revoked> ::=+  <role name>++>     ,(TestStatement ansi2011+>       "revoke role1 from role2"+>      $ RevokeRole NoAdminOptionFor [Name Nothing "role1"]+>                   [Name Nothing "role2"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "revoke role1,role2 from role3,role4"+>      $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]+>                   [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)+++>     ,(TestStatement ansi2011+>       "revoke admin option for role1 from role2 cascade"+>      $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade)+++>    ]
+ tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs view
@@ -0,0 +1,219 @@++Sections 17 and 19 in Foundation++This module covers the tests for transaction management (begin,+commit, savepoint, etc.), and session management (set).+++> module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> sql2011BitsTests :: TestItem+> sql2011BitsTests = Group "sql 2011 bits tests" [++17 Transaction management++17.1 <start transaction statement>++<start transaction statement> ::=+  START TRANSACTION [ <transaction characteristics> ]++BEGIN is not in the standard!++>      (TestStatement ansi2011+>       "start transaction"+>      $ StartTransaction)++17.2 <set transaction statement>++<set transaction statement> ::=+  SET [ LOCAL ] TRANSACTION <transaction characteristics>++17.3 <transaction characteristics>++<transaction characteristics> ::=+      [ <transaction mode> [ { <comma> <transaction mode> }... ] ]++<transaction mode> ::=+    <isolation level>+  | <transaction access mode>+  | <diagnostics size>++<transaction access mode> ::=+    READ ONLY+  | READ WRITE++<isolation level> ::=+  ISOLATION LEVEL <level of isolation>++<level of isolation> ::=+    READ UNCOMMITTED+  | READ COMMITTED+  | REPEATABLE READ+  | SERIALIZABLE++<diagnostics size> ::=+  DIAGNOSTICS SIZE <number of conditions>++<number of conditions> ::=+  <simple value specification>++17.4 <set constraints mode statement>++<set constraints mode statement> ::=+  SET CONSTRAINTS <constraint name list> { DEFERRED | IMMEDIATE }++<constraint name list> ::=+    ALL+  | <constraint name> [ { <comma> <constraint name> }... ]++17.5 <savepoint statement>++<savepoint statement> ::=+  SAVEPOINT <savepoint specifier>++<savepoint specifier> ::=+  <savepoint name>++>     ,(TestStatement ansi2011+>       "savepoint difficult_bit"+>      $ Savepoint $ Name Nothing "difficult_bit")+++17.6 <release savepoint statement>++<release savepoint statement> ::=+  RELEASE SAVEPOINT <savepoint specifier>++>     ,(TestStatement ansi2011+>       "release savepoint difficult_bit"+>      $ ReleaseSavepoint $ Name Nothing "difficult_bit")+++17.7 <commit statement>++<commit statement> ::=+  COMMIT [ WORK ] [ AND [ NO ] CHAIN ]++>     ,(TestStatement ansi2011+>       "commit"+>      $ Commit)++>     ,(TestStatement ansi2011+>       "commit work"+>      $ Commit)+++17.8 <rollback statement>++<rollback statement> ::=+  ROLLBACK [ WORK ] [ AND [ NO ] CHAIN ] [ <savepoint clause> ]++<savepoint clause> ::=+  TO SAVEPOINT <savepoint specifier>++>     ,(TestStatement ansi2011+>       "rollback"+>      $ Rollback Nothing)++>     ,(TestStatement ansi2011+>       "rollback work"+>      $ Rollback Nothing)++>     ,(TestStatement ansi2011+>       "rollback to savepoint difficult_bit"+>      $ Rollback $ Just $ Name Nothing "difficult_bit")+++19 Session management++19.1 <set session characteristics statement>++<set session characteristics statement> ::=+  SET SESSION CHARACTERISTICS AS <session characteristic list>++<session characteristic list> ::=+  <session characteristic> [ { <comma> <session characteristic> }... ]++<session characteristic> ::=+  <session transaction characteristics>++<session transaction characteristics> ::=+  TRANSACTION <transaction mode> [ { <comma> <transaction mode> }... ]++19.2 <set session user identifier statement>++<set session user identifier statement> ::=+  SET SESSION AUTHORIZATION <value specification>++19.3 <set role statement>++<set role statement> ::=+  SET ROLE <role specification>++<role specification> ::=+    <value specification>+  | NONE++19.4 <set local time zone statement>++<set local time zone statement> ::=+  SET TIME ZONE <set time zone value>++<set time zone value> ::=+    <interval value expression>+  | LOCAL++19.5 <set catalog statement>++<set catalog statement> ::=+  SET <catalog name characteristic>++<catalog name characteristic> ::=+  CATALOG <value specification>++19.6 <set schema statement>++<set schema statement> ::=+  SET <schema name characteristic>++<schema name characteristic> ::=+  SCHEMA <value specification>++19.7 <set names statement>++<set names statement> ::=+  SET <character set name characteristic>++<character set name characteristic> ::=+  NAMES <value specification>++19.8 <set path statement>++<set path statement> ::=+  SET <SQL-path characteristic>++<SQL-path characteristic> ::=+  PATH <value specification>++19.9 <set transform group statement>++<set transform group statement> ::=+  SET <transform group characteristic>++<transform group characteristic> ::=+    DEFAULT TRANSFORM GROUP <value specification>+  | TRANSFORM GROUP FOR TYPE <path-resolved user-defined type name> <value specification>++19.10 <set session collation statement>++<set session collation statement> ::=+    SET COLLATION <collation specification> [ FOR <character set specification list> ]+  | SET NO COLLATION [ FOR <character set specification list> ]++<collation specification> ::=+  <value specification>++>    ]
+ tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs view
@@ -0,0 +1,544 @@++Section 14 in Foundation+++> module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> sql2011DataManipulationTests :: TestItem+> sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"+>     [+++14 Data manipulation+++14.1 <declare cursor>++<declare cursor> ::=+  DECLARE <cursor name> <cursor properties>+      FOR <cursor specification>++14.2 <cursor properties>++<cursor properties> ::=+  [ <cursor sensitivity> ] [ <cursor scrollability> ] CURSOR+      [ <cursor holdability> ]+      [ <cursor returnability> ]++<cursor sensitivity> ::=+    SENSITIVE+  | INSENSITIVE+  | ASENSITIVE++<cursor scrollability> ::=+    SCROLL+  | NO SCROLL++<cursor holdability> ::=+    WITH HOLD+  | WITHOUT HOLD++<cursor returnability> ::=+    WITH RETURN+  | WITHOUT RETURN++14.3 <cursor specification>++<cursor specification> ::=+  <query expression> [ <updatability clause> ]++<updatability clause> ::=+  FOR { READ ONLY | UPDATE [ OF <column name list> ] }++14.4 <open statement>++<open statement> ::=+  OPEN <cursor name>++14.5 <fetch statement>++<fetch statement> ::=+     FETCH [ [ <fetch orientation> ] FROM ] <cursor name> INTO <fetch target list>++<fetch orientation> ::=+    NEXT+  | PRIOR+  | FIRST+  | LAST+  | { ABSOLUTE | RELATIVE } <simple value specification>++<fetch target list> ::=+     <target specification> [ { <comma> <target specification> }... ]+++14.6 <close statement>++<close statement> ::=+  CLOSE <cursor name>++14.7 <select statement: single row>++<select statement: single row> ::=+  SELECT [ <set quantifier> ] <select list>+      INTO <select target list>+      <table expression>++<select target list> ::=+  <target specification> [ { <comma> <target specification> }... ]++14.8 <delete statement: positioned>++<delete statement: positioned> ::=+     DELETE FROM <target table> [ [ AS ] <correlation name> ]+         WHERE CURRENT OF <cursor name>++<target table> ::=+    <table name>+  | ONLY <left paren> <table name> <right paren>++14.9 <delete statement: searched>++<delete statement: searched> ::=+  DELETE FROM <target table>+      [ FOR PORTION OF <application time period name>+        FROM <point in time 1> TO <point in time 2> ]+      [ [ AS ] <correlation name> ]+      [ WHERE <search condition> ]++>      (TestStatement ansi2011 "delete from t"+>      $ Delete [Name Nothing "t"] Nothing Nothing)++>     ,(TestStatement ansi2011 "delete from t as u"+>      $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing)++>     ,(TestStatement ansi2011 "delete from t where x = 5"+>      $ Delete [Name Nothing "t"] Nothing+>        (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))+++>     ,(TestStatement ansi2011 "delete from t as u where u.x = 5"+>      $ Delete [Name Nothing "t"] (Just (Name Nothing "u"))+>        (Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))++14.10 <truncate table statement>++<truncate table statement> ::=+  TRUNCATE TABLE <target table> [ <identity column restart option> ]++<identity column restart option> ::=+    CONTINUE IDENTITY+  | RESTART IDENTITY++>     ,(TestStatement ansi2011 "truncate table t"+>      $ Truncate [Name Nothing "t"] DefaultIdentityRestart)++>     ,(TestStatement ansi2011 "truncate table t continue identity"+>      $ Truncate [Name Nothing "t"] ContinueIdentity)++>     ,(TestStatement ansi2011 "truncate table t restart identity"+>      $ Truncate [Name Nothing "t"] RestartIdentity)+++14.11 <insert statement>++<insert statement> ::=+  INSERT INTO <insertion target> <insert columns and source>++<insertion target> ::=+  <table name>++<insert columns and source> ::=+    <from subquery>+  | <from constructor>+  | <from default>++<from subquery> ::=+  [ <left paren> <insert column list> <right paren> ]+      [ <override clause> ]+      <query expression>++<from constructor> ::=+  [ <left paren> <insert column list> <right paren> ]+      [ <override clause> ]+      <contextually typed table value constructor>++<override clause> ::=+    OVERRIDING USER VALUE+  | OVERRIDING SYSTEM VALUE++<from default> ::=+  DEFAULT VALUES++<insert column list> ::=+  <column name list>++>     ,(TestStatement ansi2011 "insert into t select * from u"+>      $ Insert [Name Nothing "t"] Nothing+>        $ InsertQuery makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "u"]]})++>     ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"+>      $ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"])+>        $ InsertQuery makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "u"]]})++>     ,(TestStatement ansi2011 "insert into t default values"+>      $ Insert [Name Nothing "t"] Nothing DefaultInsertValues)++>     ,(TestStatement ansi2011 "insert into t values(1,2)"+>      $ Insert [Name Nothing "t"] Nothing+>        $ InsertQuery $ Values [[NumLit "1", NumLit "2"]])++>     ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"+>      $ Insert [Name Nothing "t"] Nothing+>        $ InsertQuery $ Values [[NumLit "1", NumLit "2"]+>                               ,[NumLit "3", NumLit "4"]])++>     ,(TestStatement ansi2011+>       "insert into t values (default,null,array[],multiset[])"+>      $ Insert [Name Nothing "t"] Nothing+>        $ InsertQuery $ Values [[Iden [Name Nothing "default"]+>                                ,Iden [Name Nothing "null"]+>                                ,Array (Iden [Name Nothing "array"]) []+>                                ,MultisetCtor []]])+++14.12 <merge statement>++<merge statement> ::=+  MERGE INTO <target table> [ [ AS ] <merge correlation name> ]+      USING <table reference>+      ON <search condition> <merge operation specification>++merge into t+  using t+  on a = b+  merge operation specification++merge into t as u+using (table factor | joined expression)++ MERGE INTO tablename USING table_reference ON (condition)+   WHEN MATCHED THEN+   UPDATE SET column1 = value1 [, column2 = value2 ...]+   WHEN NOT MATCHED THEN+   INSERT (column1 [, column2 ...]) VALUES (value1 [, value2 ...++merge into t23+using t42+on t42.id = t23.id+when matched then+    update+    set     t23.col1 = t42.col1+when not matched then+    insert  (id, col1)+    values  (t42.id, t42.col1)++++MERGE INTO TableA u++USING (SELECT b.Key1, b.ColB1, c.ColC1++FROM TableB b++INNER JOIN TableC c ON c.KeyC1 = b.KeyB1++) s++ON (u.KeyA1 = s.KeyA1)++WHEN MATCHED THEN++UPDATE SET u.ColA1 = s.ColB1, u.ColA2 = s.ColC1+++MERGE INTO Department +USING NewDept AS ND +ON nd.Department_Number = Department.+Department_Number +WHEN MATCHED THEN UPDATE +SET budget_amount = nd.Budget_Amount +WHEN NOT MATCHED THEN INSERT +VALUES +(nd.Department_Number, nd.Department_+Name, nd.Budget_Amount, + nd.Manager_Employee_Number);+++MERGE INTO Orders2 +USING Orders3 +ON ORDERS3.Order_Number = Orders2.+Order_Number +WHEN NOT MATCHED THEN INSERT +Orders3.order_number, Orders3.+invoice_number, + Orders3.customer_number, Orders3.+initial_order_date, + Orders3.invoice_date, Orders3.+invoice_amount);++MERGE INTO Orders2 +USING Orders3 +ON ORDERS3.Order_Number = Orders2.+Order_Number AND 1=0 +WHEN NOT MATCHED THEN INSERT +(Orders3.order_number, Orders3.invoice_number, + Orders3.customer_number, Orders3.+initial_order_date, + Orders3.invoice_date, Orders3.+invoice_amount);++MERGE INTO Department +USING NewDept AS ND +ON nd.Department_Number = Department.+Department_Number +WHEN MATCHED THEN UPDATE +SET budget_amount = nd.Budget_Amount +LOGGING ALL ERRORS WITH NO LIMIT;+++MERGE INTO Department +USING + (SELECT Department_Number,+department_name, +        Budget_Amount, +Manager_Employee_Number +    FROM NewDept +    WHERE Department_Number IN +(SELECT Department_Number +        FROM Employee)) AS m+ON m.Department_Number = Department.+Department_Number +WHEN MATCHED THEN UPDATE +SET budget_amount = m.Budget_Amount +WHEN NOT MATCHED THEN INSERT +(m.Department_Number, m.Department_+Name, m.Budget_Amount, +m.Manager_Employee_Number) +LOGGING ALL ERRORS WITH NO LIMIT;++ +MERGE INTO Customers AS c+USING      Moved     AS m+      ON   m.SSN      = c.SSN+WHEN MATCHED+THEN UPDATE+SET        Street     = m.Street,+           HouseNo    = m.HouseNo,+           City       = m.City;++MERGE INTO CentralOfficeAccounts AS C    -- Target+USING BranchOfficeAccounts AS B          -- Source+   ON C.account_nbr = B.account_nbr+WHEN MATCHED THEN                        -- On match update+     UPDATE SET C.company_name = B.company_name,+                C.primary_contact = B.primary_contact,+                C.contact_phone = B.contact_phone+WHEN NOT MATCHED THEN                    -- Add missing+     INSERT (account_nbr, company_name, primary_contact, contact_phone)+     VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);+ +SELECT account_nbr, company_name, primary_contact, contact_phone +FROM CentralOfficeAccounts;++++MERGE INTO CentralOfficeAccounts AS C   -- Target+USING BranchOfficeAccounts AS B         -- Source+   ON C.account_nbr = B.account_nbr+WHEN MATCHED                            -- On match update+ AND (C.company_name <> B.company_name  -- Additional search conditions+   OR C.primary_contact <> B.primary_contact+   OR C.contact_phone <> B.contact_phone) THEN                        +     UPDATE SET C.company_name = B.company_name,+                C.primary_contact = B.primary_contact,+                C.contact_phone = B.contact_phone+WHEN NOT MATCHED THEN                   -- Add missing+     INSERT (account_nbr, company_name, primary_contact, contact_phone)+     VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);++++MERGE INTO CentralOfficeAccounts AS C   -- Target+USING BranchOfficeAccounts AS B         -- Source+   ON C.account_nbr = B.account_nbr+WHEN MATCHED                            -- On match update+ AND (C.company_name <> B.company_name  -- Additional search conditions+   OR C.primary_contact <> B.primary_contact+   OR C.contact_phone <> B.contact_phone) THEN                        +     UPDATE SET C.company_name = B.company_name,+                C.primary_contact = B.primary_contact,+                C.contact_phone = B.contact_phone+WHEN NOT MATCHED THEN                   -- Add missing+     INSERT (account_nbr, company_name, primary_contact, contact_phone)+     VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone)+WHEN SOURCE NOT MATCHED THEN            -- Delete missing from source+     DELETE;+ +SELECT account_nbr, company_name, primary_contact, contact_phone +FROM CentralOfficeAccounts; +++++<merge correlation name> ::=+  <correlation name>++<merge operation specification> ::=+  <merge when clause>...++<merge when clause> ::=+    <merge when matched clause>+  | <merge when not matched clause>++<merge when matched clause> ::=+  WHEN MATCHED [ AND <search condition> ]+      THEN <merge update or delete specification>++<merge update or delete specification> ::=+    <merge update specification>+  | <merge delete specification>++<merge when not matched clause> ::=+  WHEN NOT MATCHED [ AND <search condition> ]+      THEN <merge insert specification>++<merge update specification> ::=+  UPDATE SET <set clause list>++<merge delete specification> ::=+  DELETE++<merge insert specification> ::=+  INSERT [ <left paren> <insert column list> <right paren> ]+      [ <override clause> ]+      VALUES <merge insert value list>++<merge insert value list> ::=+  <left paren>+      <merge insert value element> [ { <comma> <merge insert value element> }... ]+      <right paren>++<merge insert value element> ::=+    <value expression>+  | <contextually typed value specification>++14.13 <update statement: positioned>++<updatestatement: positioned> ::=+     UPDATE <target table> [ [ AS ] <correlation name> ]+         SET <set clause list>+         WHERE CURRENT OF <cursor name>++14.14 <update statement: searched>++<update statement: searched> ::=+  UPDATE <target table>+      [ FOR PORTION OF <application time period name>+        FROM <point in time 1> TO <point in time 2> ]+      [ [ AS ] <correlation name> ]+      SET <set clause list>+      [ WHERE <search condition> ]+++>     ,(TestStatement ansi2011 "update t set a=b"+>      $ Update [Name Nothing "t"] Nothing+>        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)++>     ,(TestStatement ansi2011 "update t set a=b, c=5"+>      $ Update [Name Nothing "t"] Nothing+>        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])+>        ,Set [Name Nothing "c"] (NumLit "5")] Nothing)+++>     ,(TestStatement ansi2011 "update t set a=b where a>5"+>      $ Update [Name Nothing "t"] Nothing+>        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]+>        $ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))+++>     ,(TestStatement ansi2011 "update t as u set a=b where u.a>5"+>      $ Update [Name Nothing "t"] (Just $ Name Nothing "u")+>        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]+>        $ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"])+>                       [Name Nothing ">"] (NumLit "5"))++>     ,(TestStatement ansi2011 "update t set (a,b)=(3,5)"+>      $ Update [Name Nothing "t"] Nothing+>        [SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]+>                     [NumLit "3", NumLit "5"]] Nothing)++++14.15 <set clause list>++<set clause list> ::=+  <set clause> [ { <comma> <set clause> }... ]++<set clause> ::=+    <multiple column assignment>+  | <set target> <equals operator> <update source>++<set target> ::=+    <update target>+  | <mutated set clause>++<multiple column assignment> ::=+  <set target list> <equals operator> <assigned row>++<set target list> ::=+  <left paren> <set target> [ { <comma> <set target> }... ] <right paren>++<assigned row> ::=+  <contextually typed row value expression>++<update target> ::=+    <object column>+  | <object column>+      <left bracket or trigraph> <simple value specification> <right bracket or trigraph>++<object column> ::=+  <column name>++<mutated set clause> ::=+  <mutated target> <period> <method name>++<mutated target> ::=+    <object column>+  | <mutated set clause>++<update source> ::=+    <value expression>+  | <contextually typed value specification>++14.16 <temporary table declaration>++<temporary table declaration> ::=+  DECLARE LOCAL TEMPORARY TABLE <table name> <table element list>+      [ ON COMMIT <table commit action> ROWS ]++declare local temporary table t (a int) [on commit {preserve | delete} rows]++14.17 <free locator statement>++<free locator statement> ::=+  FREE LOCATOR <locator reference> [ { <comma> <locator reference> }... ]++<locator reference> ::=+    <host parameter name>+  | <embedded variable name>+  | <dynamic parameter specification>++14.18 <hold locator statement>++<hold locator statement> ::=+  HOLD LOCATOR <locator reference> [ { <comma> <locator reference> }... ]+++>    ]
+ tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs view
@@ -0,0 +1,4341 @@++This file goes through the grammar for SQL 2011 queries (using the+draft standard).++There are other files which cover some of the other sections from SQL+2011 (ddl, non-query dml, etc).++Possible sections not in the todo which could+be covered:++13 modules+16 control statements+18 connection management+20 dynamic+22 direct+23 diagnostics++procedural sql++some of the main areas being left for now:+temporal and versioning stuff+modules+ref stuff+todo: finish this list++++The goal is to create some example tests for each bit of grammar, with+some areas getting more comprehensive coverage tests, and also to note+which parts aren't currently supported.++> module Language.SQL.SimpleSQL.SQL2011Queries (sql2011QueryTests) where+> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> sql2011QueryTests :: TestItem+> sql2011QueryTests = Group "sql 2011 query tests"+>     [literals+>     ,identifiers+>     ,typeNameTests+>     ,fieldDefinition+>     ,valueExpressions+>     ,queryExpressions+>     ,scalarSubquery+>     ,predicates+>     ,intervalQualifier+>     ,collateClause+>     ,aggregateFunction+>     ,sortSpecificationList+>     ]++= 5 Lexical elements++The tests don't make direct use of these definitions.++== 5.1 <SQL terminal character>++Function++Define the terminal symbols of the SQL language and the elements of+strings.++<SQL terminal character> ::= <SQL language character>++<SQL language character> ::=+    <simple Latin letter>+  | <digit>+  | <SQL special character>++<simple Latin letter> ::=+    <simple Latin upper case letter>+  | <simple Latin lower case letter>++<simple Latin upper case letter> ::=+    A | B | C | D | E | F | G | H | I | J | K | L | M | N | O+  | P | Q | R | S | T | U | V | W | X | Y | Z++<simple Latin lower case letter> ::=+    a | b | c | d | e | f | g | h | i | j | k | l | m | n | o+  | p | q | r | s | t | u | v | w | x | y | z++<digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9++<SQL special character> ::=+    <space>+  | <double quote>+  | <percent>+  | <ampersand>+  | <quote>+  | <left paren>+  | <right paren>+  | <asterisk>+  | <plus sign>+  | <comma>+  | <minus sign>+  | <period>+  | <solidus>+  | <colon>+  | <semicolon>+  | <less than operator>+  | <equals operator>+  | <greater than operator>+  | <question mark>+  | <left bracket>+  | <right bracket>+  | <circumflex>+  | <underscore>+  | <vertical bar>+  | <left brace>+  | <right brace>++<space> ::= !! See the Syntax Rules.++<double quote> ::= "++<percent> ::= %++<ampersand> ::= &++<quote> ::= '++<left paren> ::= (++<right paren> ::= )++<asterisk> ::= *++<plus sign> ::= +++<comma> ::= ,++<minus sign> ::= -++<period> ::= .++<solidus> ::= /++<reverse solidus> ::= \++<colon> ::= :++<semicolon> ::= ;++<less than operator> ::= <++<equals operator> ::= =++<greater than operator> ::= >++<question mark> ::= ?++<left bracket or trigraph> ::= <left bracket> | <left bracket trigraph>++<right bracket or trigraph> ::= <right bracket> | <right bracket trigraph>++<left bracket> ::= [++<left bracket trigraph> ::= ??(++<right bracket> ::= ]++<right bracket trigraph> ::= ??)++<circumflex> ::= ^++<underscore> ::= _++<vertical bar> ::= |++<left brace> ::= {++<right brace> ::= }++== 5.2 <token> and <separator>++Function++Specify lexical units (tokens and separators) that participate in SQL+language.++<token> ::= <nondelimiter token> | <delimiter token>++<nondelimiter token> ::=+    <regular identifier>+  | <key word>+  | <unsigned numeric literal>+  | <national character string literal>+  | <binary string literal>+  | <large object length token>+  | <Unicode delimited identifier>+  | <Unicode character string literal>+  | <SQL language identifier>++<regular identifier> ::= <identifier body>++<identifier body> ::= <identifier start> [ <identifier part>... ]++<identifier part> ::= <identifier start> | <identifier extend>++<identifier start> ::= !! See the Syntax Rules.++<identifier extend> ::= !! See the Syntax Rules.++<large object length token> ::= <digit>... <multiplier>++<multiplier> ::= K | M | G | T | P++<delimited identifier> ::=+  <double quote> <delimited identifier body> <double quote>++<delimited identifier body> ::= <delimited identifier part>...++<delimited identifier part> ::=+    <nondoublequote character>+  | <doublequote symbol>++<Unicode delimited identifier> ::=+  U <ampersand> <double quote> <Unicode delimiter body> <double quote>+      <Unicode escape specifier>++<Unicode escape specifier> ::=+  [ UESCAPE <quote> <Unicode escape character> <quote> ]++<Unicode delimiter body> ::= <Unicode identifier part>...++<Unicode identifier part> ::=+    <delimited identifier part>+  | <Unicode escape value>++<Unicode escape value> ::=+    <Unicode 4 digit escape value>+  | <Unicode 6 digit escape value>+  | <Unicode character escape value>++<Unicode 4 digit escape value> ::=+  <Unicode escape character> <hexit> <hexit> <hexit> <hexit>++<Unicode 6 digit escape value> ::=+  <Unicode escape character> <plus sign>+      <hexit> <hexit> <hexit> <hexit> <hexit> <hexit>++<Unicode character escape value> ::=+  <Unicode escape character> <Unicode escape character>++<Unicode escape character> ::= !! See the Syntax Rules.++<nondoublequote character> ::= !! See the Syntax Rules.++<doublequote symbol> ::= ""!! two consecutive double quote characters++<delimiter token> ::=+    <character string literal>+  | <date string>+  | <time string>+  | <timestamp string>+  | <interval string>+  | <delimited identifier>+  | <SQL special character>+  | <not equals operator>+  | <greater than or equals operator>+  | <less than or equals operator>+  | <concatenation operator>+  | <right arrow>+  | <left bracket trigraph>+  | <right bracket trigraph>+  | <double colon>+  | <double period>+  | <named argument assignment token>++<not equals operator> ::= <>++<greater than or equals operator> ::= >=++<less than or equals operator> ::= <=++<concatenation operator> ::= ||++<right arrow> ::= ->++<double colon> ::= ::++<double period> ::= ..++<named argument assignment token> ::= =>++<separator> ::= { <comment> | <white space> }...++<white space> ::= !! See the Syntax Rules.++<comment> ::= <simple comment> | <bracketed comment>++<simple comment> ::=+  <simple comment introducer> [ <comment character>... ] <newline>++<simple comment introducer> ::= <minus sign> <minus sign>++<bracketed comment> ::=+  <bracketed comment introducer>+      <bracketed comment contents>+      <bracketed comment terminator>++<bracketed comment introducer> ::= /*++<bracketed comment terminator> ::= */++<bracketed comment contents> ::=+  [ { <comment character> | <separator> }... ]!! See the Syntax Rules.++<comment character> ::= <nonquote character> | <quote>++<newline> ::= !! See the Syntax Rules.++<key word> ::= <reserved word> | <non-reserved word>++<non-reserved word> ::=+    A | ABSOLUTE | ACTION | ADA | ADD | ADMIN | AFTER | ALWAYS | ASC+  | ASSERTION | ASSIGNMENT | ATTRIBUTE | ATTRIBUTES++  | BEFORE | BERNOULLI | BREADTH++  | C | CASCADE | CATALOG | CATALOG_NAME | CHAIN | CHARACTER_SET_CATALOG+  | CHARACTER_SET_NAME | CHARACTER_SET_SCHEMA | CHARACTERISTICS | CHARACTERS+  | CLASS_ORIGIN | COBOL | COLLATION | COLLATION_CATALOG | COLLATION_NAME | COLLATION_SCHEMA+  | COLUMN_NAME | COMMAND_FUNCTION | COMMAND_FUNCTION_CODE | COMMITTED+  | CONDITION_NUMBER | CONNECTION | CONNECTION_NAME | CONSTRAINT_CATALOG | CONSTRAINT_NAME+  | CONSTRAINT_SCHEMA | CONSTRAINTS | CONSTRUCTOR | CONTINUE | CURSOR_NAME++  | DATA | DATETIME_INTERVAL_CODE | DATETIME_INTERVAL_PRECISION | DEFAULTS | DEFERRABLE+  | DEFERRED | DEFINED | DEFINER | DEGREE | DEPTH | DERIVED | DESC | DESCRIPTOR+  | DIAGNOSTICS | DISPATCH | DOMAIN | DYNAMIC_FUNCTION | DYNAMIC_FUNCTION_CODE++  | ENFORCED | EXCLUDE | EXCLUDING | EXPRESSION++  | FINAL | FIRST | FLAG | FOLLOWING | FORTRAN | FOUND++  | G | GENERAL | GENERATED | GO | GOTO | GRANTED++  | HIERARCHY++  | IGNORE | IMMEDIATE | IMMEDIATELY | IMPLEMENTATION | INCLUDING | INCREMENT | INITIALLY+  | INPUT | INSTANCE | INSTANTIABLE | INSTEAD | INVOKER | ISOLATION++  | K | KEY | KEY_MEMBER | KEY_TYPE++  | LAST | LENGTH | LEVEL | LOCATOR++  | M | MAP | MATCHED | MAXVALUE | MESSAGE_LENGTH | MESSAGE_OCTET_LENGTH+  | MESSAGE_TEXT | MINVALUE | MORE | MUMPS++  | NAME | NAMES | NESTING | NEXT | NFC | NFD | NFKC | NFKD+  | NORMALIZED | NULLABLE | NULLS | NUMBER++  | OBJECT | OCTETS | OPTION | OPTIONS | ORDERING | ORDINALITY | OTHERS+  | OUTPUT | OVERRIDING++  | P | PAD | PARAMETER_MODE | PARAMETER_NAME | PARAMETER_ORDINAL_POSITION+  | PARAMETER_SPECIFIC_CATALOG | PARAMETER_SPECIFIC_NAME | PARAMETER_SPECIFIC_SCHEMA+  | PARTIAL | PASCAL | PATH | PLACING | PLI | PRECEDING | PRESERVE | PRIOR+  | PRIVILEGES | PUBLIC++  | READ | RELATIVE | REPEATABLE | RESPECT | RESTART | RESTRICT | RETURNED_CARDINALITY+  | RETURNED_LENGTH | RETURNED_OCTET_LENGTH | RETURNED_SQLSTATE | ROLE+  | ROUTINE | ROUTINE_CATALOG | ROUTINE_NAME | ROUTINE_SCHEMA | ROW_COUNT++  | SCALE | SCHEMA | SCHEMA_NAME | SCOPE_CATALOG | SCOPE_NAME | SCOPE_SCHEMA+  | SECTION | SECURITY | SELF | SEQUENCE | SERIALIZABLE | SERVER_NAME | SESSION+  | SETS | SIMPLE | SIZE | SOURCE | SPACE | SPECIFIC_NAME | STATE | STATEMENT+  | STRUCTURE | STYLE | SUBCLASS_ORIGIN++  | T | TABLE_NAME | TEMPORARY | TIES | TOP_LEVEL_COUNT | TRANSACTION+  | TRANSACTION_ACTIVE | TRANSACTIONS_COMMITTED | TRANSACTIONS_ROLLED_BACK+  | TRANSFORM | TRANSFORMS | TRIGGER_CATALOG | TRIGGER_NAME | TRIGGER_SCHEMA | TYPE++  | UNBOUNDED | UNCOMMITTED | UNDER | UNNAMED | USAGE | USER_DEFINED_TYPE_CATALOG+  | USER_DEFINED_TYPE_CODE | USER_DEFINED_TYPE_NAME | USER_DEFINED_TYPE_SCHEMA++  | VIEW++  | WORK | WRITE++  | ZONE++<reserved word> ::=+    ABS | ALL | ALLOCATE | ALTER | AND | ANY | ARE | ARRAY | ARRAY_AGG+  | ARRAY_MAX_CARDINALITY | AS | ASENSITIVE | ASYMMETRIC | AT | ATOMIC | AUTHORIZATION+  | AVG++  | BEGIN | BEGIN_FRAME | BEGIN_PARTITION | BETWEEN | BIGINT | BINARY+  | BLOB | BOOLEAN | BOTH | BY++  | CALL | CALLED | CARDINALITY | CASCADED | CASE | CAST | CEIL | CEILING+  | CHAR | CHAR_LENGTH | CHARACTER | CHARACTER_LENGTH | CHECK | CLOB | CLOSE+  | COALESCE | COLLATE | COLLECT | COLUMN | COMMIT | CONDITION | CONNECT+  | CONSTRAINT | CONTAINS | CONVERT | CORR | CORRESPONDING | COUNT | COVAR_POP+  | COVAR_SAMP | CREATE | CROSS | CUBE | CUME_DIST | CURRENT | CURRENT_CATALOG+  | CURRENT_DATE | CURRENT_DEFAULT_TRANSFORM_GROUP | CURRENT_PATH | CURRENT_ROLE+  | CURRENT_ROW | CURRENT_SCHEMA | CURRENT_TIME | CURRENT_TIMESTAMP+  | CURRENT_TRANSFORM_GROUP_FOR_TYPE | CURRENT_USER | CURSOR | CYCLE++  | DATE | DAY | DEALLOCATE | DEC | DECIMAL | DECLARE | DEFAULT | DELETE+  | DENSE_RANK | DEREF | DESCRIBE | DETERMINISTIC | DISCONNECT | DISTINCT+  | DOUBLE | DROP | DYNAMIC++  | EACH | ELEMENT | ELSE | END | END_FRAME | END_PARTITION | END-EXEC+  | EQUALS | ESCAPE | EVERY | EXCEPT | EXEC | EXECUTE | EXISTS | EXP+  | EXTERNAL | EXTRACT++  | FALSE | FETCH | FILTER | FIRST_VALUE | FLOAT | FLOOR | FOR | FOREIGN+  | FRAME_ROW | FREE | FROM | FULL | FUNCTION | FUSION++  | GET | GLOBAL | GRANT | GROUP | GROUPING | GROUPS++  | HAVING | HOLD | HOUR++  | IDENTITY | IN | INDICATOR | INNER | INOUT | INSENSITIVE | INSERT+  | INT | INTEGER | INTERSECT | INTERSECTION | INTERVAL | INTO | IS++  | JOIN++  | LAG | LANGUAGE | LARGE | LAST_VALUE | LATERAL | LEAD | LEADING | LEFT+  | LIKE | LIKE_REGEX | LN | LOCAL | LOCALTIME | LOCALTIMESTAMP | LOWER++  | MATCH | MAX | MEMBER | MERGE | METHOD | MIN | MINUTE+  | MOD | MODIFIES | MODULE | MONTH | MULTISET++  | NATIONAL | NATURAL | NCHAR | NCLOB | NEW | NO | NONE | NORMALIZE | NOT+  | NTH_VALUE | NTILE | NULL | NULLIF | NUMERIC++  | OCTET_LENGTH | OCCURRENCES_REGEX | OF | OFFSET | OLD | ON | ONLY | OPEN+  | OR | ORDER | OUT | OUTER | OVER | OVERLAPS | OVERLAY++  | PARAMETER | PARTITION | PERCENT | PERCENT_RANK | PERCENTILE_CONT+  | PERCENTILE_DISC | PERIOD | PORTION | POSITION | POSITION_REGEX | POWER | PRECEDES+  | PRECISION | PREPARE | PRIMARY | PROCEDURE++  | RANGE | RANK | READS | REAL | RECURSIVE | REF | REFERENCES | REFERENCING+  | REGR_AVGX | REGR_AVGY | REGR_COUNT | REGR_INTERCEPT | REGR_R2 | REGR_SLOPE+  | REGR_SXX | REGR_SXY | REGR_SYY | RELEASE | RESULT | RETURN | RETURNS+  | REVOKE | RIGHT | ROLLBACK | ROLLUP | ROW | ROW_NUMBER | ROWS++  | SAVEPOINT | SCOPE | SCROLL | SEARCH | SECOND | SELECT+  | SENSITIVE | SESSION_USER | SET | SIMILAR | SMALLINT | SOME | SPECIFIC+  | SPECIFICTYPE | SQL | SQLEXCEPTION | SQLSTATE | SQLWARNING | SQRT | START+  | STATIC | STDDEV_POP | STDDEV_SAMP | SUBMULTISET | SUBSTRING | SUBSTRING_REGEX+  | SUCCEEDS | SUM | SYMMETRIC | SYSTEM | SYSTEM_TIME | SYSTEM_USER++  | TABLE | TABLESAMPLE | THEN | TIME | TIMESTAMP | TIMEZONE_HOUR | TIMEZONE_MINUTE+  | TO | TRAILING | TRANSLATE | TRANSLATE_REGEX | TRANSLATION | TREAT+  | TRIGGER | TRUNCATE | TRIM | TRIM_ARRAY | TRUE++  | UESCAPE | UNION | UNIQUE | UNKNOWN | UNNEST | UPDATE | UPPER | USER | USING++  | VALUE | VALUES | VALUE_OF | VAR_POP | VAR_SAMP | VARBINARY+  | VARCHAR | VARYING | VERSIONING++  | WHEN | WHENEVER | WHERE | WIDTH_BUCKET | WINDOW | WITH | WITHIN | WITHOUT++  | YEAR++== 5.3 <literal>++Function+Specify a non-null value.++> literals :: TestItem+> literals = Group "literals"+>     [numericLiterals,generalLiterals]++<literal> ::= <signed numeric literal> | <general literal>++<unsigned literal> ::= <unsigned numeric literal> | <general literal>++<general literal> ::=+    <character string literal>+  | <national character string literal>+  | <Unicode character string literal>+  | <binary string literal>+  | <datetime literal>+  | <interval literal>+  | <boolean literal>++> generalLiterals :: TestItem+> generalLiterals = Group "general literals"+>     [characterStringLiterals+>     ,nationalCharacterStringLiterals+>     ,unicodeCharacterStringLiterals+>     ,binaryStringLiterals+>     ,dateTimeLiterals+>     ,intervalLiterals+>     ,booleanLiterals]++<character string literal> ::=+  [ <introducer> <character set specification> ]+      <quote> [ <character representation>... ] <quote>+      [ { <separator> <quote> [ <character representation>... ] <quote> }... ]++<introducer> ::= <underscore>++<character representation> ::= <nonquote character> | <quote symbol>++<nonquote character> ::= !! See the Syntax Rules.++<quote symbol> ::= <quote> <quote>++> characterStringLiterals :: TestItem+> characterStringLiterals = Group "character string literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("'a regular string literal'"+>      ,StringLit "'" "'" "a regular string literal")+>     ,("'something' ' some more' 'and more'"+>      ,StringLit "'" "'" "something some moreand more")+>     ,("'something' \n ' some more' \t 'and more'"+>      ,StringLit "'" "'" "something some moreand more")+>     ,("'something' -- a comment\n ' some more' /*another comment*/ 'and more'"+>      ,StringLit "'" "'" "something some moreand more")+>     ,("'a quote: '', stuff'"+>      ,StringLit "'" "'" "a quote: '', stuff")+>     ,("''"+>      ,StringLit "'" "'" "")++I'm not sure how this should work. Maybe the parser should reject non+ascii characters in strings and identifiers unless the current SQL+character set allows them.++>     ,("_francais 'français'"+>      ,TypedLit (TypeName [Name Nothing "_francais"]) "français")+>     ]++<national character string literal> ::=+  N <quote> [ <character representation>... ]+      <quote> [ { <separator> <quote> [ <character representation>... ] <quote> }... ]++> nationalCharacterStringLiterals :: TestItem+> nationalCharacterStringLiterals = Group "national character string literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("N'something'", StringLit "N'" "'" "something")+>     ,("n'something'", StringLit "n'" "'" "something")+>     ]++<Unicode character string literal> ::=+  [ <introducer> <character set specification> ]+      U <ampersand> <quote> [ <Unicode representation>... ] <quote>+      [ { <separator> <quote> [ <Unicode representation>... ] <quote> }... ]+      <Unicode escape specifier>++<Unicode representation> ::=+    <character representation>+  | <Unicode escape value>++> unicodeCharacterStringLiterals :: TestItem+> unicodeCharacterStringLiterals = Group "unicode character string literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("U&'something'", StringLit "U&'" "'" "something")+>     {-,("u&'something' escape ="+>      ,Escape (StringLit "u&'" "'" "something") '=')+>     ,("u&'something' uescape ="+>      ,UEscape (StringLit "u&'" "'" "something") '=')-}+>     ]++TODO: unicode escape++<binary string literal> ::=+  X <quote> [ <space>... ] [ { <hexit> [ <space>... ] <hexit> [ <space>... ] }... ] <quote>+      [ { <separator> <quote> [ <space>... ] [ { <hexit> [ <space>... ]+      <hexit> [ <space>... ] }... ] <quote> }... ]++<hexit> ::= <digit> | A | B | C | D | E | F | a | b | c | d | e | f++> binaryStringLiterals :: TestItem+> binaryStringLiterals = Group "binary string literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [--("B'101010'", CSStringLit "B" "101010")+>      ("X'7f7f7f'", StringLit "X'" "'" "7f7f7f")+>     --,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z')+>     ]++<signed numeric literal> ::= [ <sign> ] <unsigned numeric literal>++<unsigned numeric literal> ::=+    <exact numeric literal>+  | <approximate numeric literal>++<exact numeric literal> ::=+    <unsigned integer> [ <period> [ <unsigned integer> ] ]+  | <period> <unsigned integer>++<sign> ::= <plus sign> | <minus sign>++<approximate numeric literal> ::= <mantissa> E <exponent>++<mantissa> ::= <exact numeric literal>++<exponent> ::= <signed integer>++<signed integer> ::= [ <sign> ] <unsigned integer>++<unsigned integer> ::= <digit>...++> numericLiterals :: TestItem+> numericLiterals = Group "numeric literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("11", NumLit "11")+>     ,("11.11", NumLit "11.11")++>     ,("11E23", NumLit "11E23")+>     ,("11E+23", NumLit "11E+23")+>     ,("11E-23", NumLit "11E-23")++>     ,("11.11E23", NumLit "11.11E23")+>     ,("11.11E+23", NumLit "11.11E+23")+>     ,("11.11E-23", NumLit "11.11E-23")++>     ,("+11E23", PrefixOp [Name Nothing "+"] $ NumLit "11E23")+>     ,("+11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11E+23")+>     ,("+11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11E-23")+>     ,("+11.11E23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E23")+>     ,("+11.11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23")+>     ,("+11.11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23")++>     ,("-11E23", PrefixOp [Name Nothing "-"] $ NumLit "11E23")+>     ,("-11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11E+23")+>     ,("-11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11E-23")+>     ,("-11.11E23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E23")+>     ,("-11.11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23")+>     ,("-11.11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23")++>     ,("11.11e23", NumLit "11.11e23")++>     ]++<datetime literal> ::= <date literal> | <time literal> | <timestamp literal>++<date literal> ::= DATE <date string>++<time literal> ::= TIME <time string>++<timestamp literal> ::= TIMESTAMP <timestamp string>++<date string> ::= <quote> <unquoted date string> <quote>++<time string> ::= <quote> <unquoted time string> <quote>++<timestamp string> ::= <quote> <unquoted timestamp string> <quote>++<time zone interval> ::= <sign> <hours value> <colon> <minutes value>++<date value> ::=+  <years value> <minus sign> <months value> <minus sign> <days value>++<time value> ::= <hours value> <colon> <minutes value> <colon> <seconds value>++> dateTimeLiterals :: TestItem+> dateTimeLiterals = Group "datetime literals"+>     [-- TODO: datetime literals+>     ]++<interval literal> ::=+  INTERVAL [ <sign> ] <interval string> <interval qualifier>++<interval string> ::= <quote> <unquoted interval string> <quote>++<unquoted date string> ::= <date value>++<unquoted time string> ::= <time value> [ <time zone interval> ]++<unquoted timestamp string> ::=+  <unquoted date string> <space> <unquoted time string>++<unquoted interval string> ::=+  [ <sign> ] { <year-month literal> | <day-time literal> }++<year-month literal> ::=+    <years value> [ <minus sign> <months value> ]+  | <months value>++<day-time literal> ::= <day-time interval> | <time interval>++<day-time interval> ::=+  <days value> [ <space> <hours value> [ <colon> <minutes value>+      [ <colon> <seconds value> ] ] ]++<time interval> ::=+    <hours value> [ <colon> <minutes value> [ <colon> <seconds value> ] ]+  | <minutes value> [ <colon> <seconds value> ]+  | <seconds value>++<years value> ::= <datetime value>++<months value> ::= <datetime value>++<days value> ::= <datetime value>++<hours value> ::= <datetime value>++<minutes value> ::= <datetime value>++<seconds value> ::= <seconds integer value> [ <period> [ <seconds fraction> ] ]++<seconds integer value> ::= <unsigned integer>++<seconds fraction> ::= <unsigned integer>++<datetime value> ::= <unsigned integer>++> intervalLiterals :: TestItem+> intervalLiterals = Group "intervalLiterals literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("interval '1'", TypedLit (TypeName [Name Nothing "interval"]) "1")+>     ,("interval '1' day"+>      ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)+>     ,("interval '1' day(3)"+>      ,IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing)+>     ,("interval + '1' day(3)"+>      ,IntervalLit (Just Plus) "1" (Itf "day" $ Just (3,Nothing)) Nothing)+>     ,("interval - '1' second(2,2)"+>      ,IntervalLit (Just Minus) "1" (Itf "second" $ Just (2,Just 2)) Nothing)+>     ,("interval '1' year to month"+>      ,IntervalLit Nothing "1" (Itf "year" Nothing)+>                                   (Just $ Itf "month" Nothing))++>     ,("interval '1' year(4) to second(2,3) "+>      ,IntervalLit Nothing "1" (Itf "year" $ Just (4,Nothing))+>                             (Just $ Itf "second" $ Just (2, Just 3)))+>     ]++<boolean literal> ::= TRUE | FALSE | UNKNOWN++> booleanLiterals :: TestItem+> booleanLiterals = Group "boolean literals"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("true", Iden [Name Nothing "true"])+>     ,("false", Iden [Name Nothing "false"])+>     ,("unknown", Iden [Name Nothing "unknown"])+>     ]++== 5.4 Names and identifiers++Function+Specify names.++<identifier> ::= <actual identifier>++<actual identifier> ::=+    <regular identifier>+  | <delimited identifier>+  | <Unicode delimited identifier>++> identifiers :: TestItem+> identifiers = Group "identifiers"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("test",Iden [Name Nothing "test"])+>     ,("_test",Iden [Name Nothing "_test"])+>     ,("t1",Iden [Name Nothing "t1"])+>     ,("a.b",Iden [Name Nothing "a", Name Nothing "b"])+>     ,("a.b.c",Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"])+>     ,("\"quoted iden\"", Iden [Name (Just ("\"","\"")) "quoted iden"])+>     ,("\"quoted \"\" iden\"", Iden [Name (Just ("\"","\"")) "quoted \"\" iden"])+>     ,("U&\"quoted iden\"", Iden [Name (Just ("U&\"","\"")) "quoted iden"])+>     ,("U&\"quoted \"\" iden\"", Iden [Name (Just ("U&\"","\"")) "quoted \"\" iden"])+>     ]++TODO: more identifiers, e.g. unicode escapes?, mixed quoted/unquoted+chains++TODO: review below stuff for exact rules++<SQL language identifier> ::=+  <SQL language identifier start> [ <SQL language identifier part>... ]++<SQL language identifier start> ::= <simple Latin letter>++<SQL language identifier part> ::=+    <simple Latin letter>+  | <digit>+  | <underscore>++<authorization identifier> ::= <role name> | <user identifier>++<table name> ::= <local or schema qualified name>++<domain name> ::= <schema qualified name>++<schema name> ::= [ <catalog name> <period> ] <unqualified schema name>++<unqualified schema name> ::= <identifier>++<catalog name> ::= <identifier>++<schema qualified name> ::= [ <schema name> <period> ] <qualified identifier>++<local or schema qualified name> ::=+  [ <local or schema qualifier> <period> ] <qualified identifier>++<local or schema qualifier> ::= <schema name> | <local qualifier>++<qualified identifier> ::= <identifier>++<column name> ::= <identifier>++<correlation name> ::= <identifier>++<query name> ::= <identifier>++<SQL-client module name> ::= <identifier>++<procedure name> ::= <identifier>++<schema qualified routine name> ::= <schema qualified name>++<method name> ::= <identifier>++<specific name> ::= <schema qualified name>++<cursor name> ::= <local qualified name>++<local qualified name> ::=+  [ <local qualifier> <period> ] <qualified identifier>++<local qualifier> ::= MODULE++<host parameter name> ::= <colon> <identifier>++<SQL parameter name> ::= <identifier>++<constraint name> ::= <schema qualified name>++<external routine name> ::= <identifier> | <character string literal>++<trigger name> ::= <schema qualified name>++<collation name> ::= <schema qualified name>++<character set name> ::= [ <schema name> <period> ] <SQL language identifier>++<transliteration name> ::= <schema qualified name>++<transcoding name> ::= <schema qualified name>++<schema-resolved user-defined type name> ::= <user-defined type name>++<user-defined type name> ::= [ <schema name> <period> ] <qualified identifier>++<attribute name> ::= <identifier>++<field name> ::= <identifier>++<savepoint name> ::= <identifier>++<sequence generator name> ::= <schema qualified name>++<role name> ::= <identifier>++<user identifier> ::= <identifier>++<connection name> ::= <simple value specification>++<SQL-server name> ::= <simple value specification>++<connection user name> ::= <simple value specification>++<SQL statement name> ::= <statement name> | <extended statement name>++<statement name> ::= <identifier>++<extended statement name> ::= [ <scope option> ] <simple value specification>++<dynamic cursor name> ::= <cursor name> | <extended cursor name>++<extended cursor name> ::= [ <scope option> ] <simple value specification>++<descriptor name> ::=+    <non-extended descriptor name>+  | <extended descriptor name>++<non-extended descriptor name> ::= <identifier>++<extended descriptor name> ::= [ <scope option> ] <simple value specification>++<scope option> ::= GLOBAL | LOCAL++<window name> ::= <identifier>++= 6 Scalar expressions++== 6.1 <data type>++Function+Specify a data type.++<data type> ::=+    <predefined type>+  | <row type>+  | <path-resolved user-defined type name>+  | <reference type>+  | <collection type>++<predefined type> ::=+    <character string type> [ CHARACTER SET <character set specification> ]+          [ <collate clause> ]+  | <national character string type> [ <collate clause> ]+  | <binary string type>+  | <numeric type>+  | <boolean type>+  | <datetime type>+  | <interval type>++<character string type> ::=+    CHARACTER [ <left paren> <character length> <right paren> ]+  | CHAR [ <left paren> <character length> <right paren> ]+  | CHARACTER VARYING <left paren> <character length> <right paren>+  | CHAR VARYING <left paren> <character length> <right paren>+  | VARCHAR <left paren> <character length> <right paren>+  | <character large object type>++<character large object type> ::=+    CHARACTER LARGE OBJECT [ <left paren> <character large object length> <right paren> ]+  | CHAR LARGE OBJECT [ <left paren> <character large object length> <right paren> ]+  | CLOB [ <left paren> <character large object length> <right paren> ]++<national character string type> ::=+    NATIONAL CHARACTER [ <left paren> <character length> <right paren> ]+  | NATIONAL CHAR [ <left paren> <character length> <right paren> ]+  | NCHAR [ <left paren> <character length> <right paren> ]+  | NATIONAL CHARACTER VARYING <left paren> <character length> <right paren>+  | NATIONAL CHAR VARYING <left paren> <character length> <right paren>+  | NCHAR VARYING <left paren> <character length> <right paren>+  | <national character large object type>++<national character large object type> ::=+    NATIONAL CHARACTER LARGE OBJECT [ <left paren> <character large object length> <right+    paren> ]+  | NCHAR LARGE OBJECT [ <left paren> <character large object length> <right paren> ]+  | NCLOB [ <left paren> <character large object length> <right paren> ]++<binary string type> ::=+    BINARY [ <left paren> <length> <right paren> ]+  | BINARY VARYING <left paren> <length> <right paren>+  | VARBINARY <left paren> <length> <right paren>+  | <binary large object string type>++<binary large object string type> ::=+    BINARY LARGE OBJECT [ <left paren> <large object length> <right paren> ]+  | BLOB [ <left paren> <large object length> <right paren> ]++<numeric type> ::= <exact numeric type> | <approximate numeric type>++<exact numeric type> ::=+    NUMERIC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+  | DECIMAL [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+  | DEC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+  | SMALLINT+  | INTEGER+  | INT+  | BIGINT++<approximate numeric type> ::=+    FLOAT [ <left paren> <precision> <right paren> ]+  | REAL+  | DOUBLE PRECISION++<length> ::= <unsigned integer>++<character length> ::= <length> [ <char length units> ]++<large object length> ::=+    <length> [ <multiplier> ]+  | <large object length token>++<character large object length> ::=+  <large object length> [ <char length units> ]++<char length units> ::= CHARACTERS | OCTETS++<precision> ::= <unsigned integer>++<scale> ::= <unsigned integer>++<boolean type> ::= BOOLEAN++<datetime type> ::=+    DATE+  | TIME [ <left paren> <time precision> <right paren> ] [ <with or without time zone> ]+  | TIMESTAMP [ <left paren> <timestamp precision> <right paren> ]+      [ <with or without time zone> ]++<with or without time zone> ::= WITH TIME ZONE | WITHOUT TIME ZONE++<time precision> ::= <time fractional seconds precision>++<timestamp precision> ::= <time fractional seconds precision>++<time fractional seconds precision> ::= <unsigned integer>++<interval type> ::= INTERVAL <interval qualifier>++<row type> ::= ROW <row type body>++<row type body> ::=+  <left paren> <field definition> [ { <comma> <field definition> }... ] <right paren>++<reference type> ::=+  REF <left paren> <referenced type> <right paren> [ <scope clause> ]++<scope clause> ::= SCOPE <table name>++<referenced type> ::= <path-resolved user-defined type name>++<path-resolved user-defined type name> ::= <user-defined type name>++<collection type> ::= <array type> | <multiset type>++<array type> ::=+  <data type> ARRAY+      [ <left bracket or trigraph> <maximum cardinality> <right bracket or trigraph> ]++<maximum cardinality> ::= <unsigned integer>++<multiset type> ::= <data type> MULTISET++TODO: below, add new stuff:+review the length syntaxes+binary, binary varying/varbinary+new multipliers++create a list of type name variations:++> typeNames :: ([(String,TypeName)],[(String,TypeName)])+> typeNames =+>     (basicTypes, concatMap makeArray basicTypes+>                  ++ map makeMultiset basicTypes)+>   where+>     makeArray (s,t) = [(s ++ " array", ArrayTypeName t Nothing)+>                       ,(s ++ " array[5]", ArrayTypeName t (Just 5))]+>     makeMultiset (s,t) = (s ++ " multiset", MultisetTypeName t)+>     basicTypes =+>         -- example of every standard type name+>         map (\t -> (t,TypeName [Name Nothing t]))+>         ["binary"+>         ,"binary varying"+>         ,"character"+>         ,"char"+>         ,"character varying"+>         ,"char varying"+>         ,"varbinary"+>         ,"varchar"+>         ,"character large object"+>         ,"char large object"+>         ,"clob"+>         ,"national character"+>         ,"national char"+>         ,"nchar"+>         ,"national character varying"+>         ,"national char varying"+>         ,"nchar varying"+>         ,"national character large object"+>         ,"nchar large object"+>         ,"nclob"+>         ,"binary large object"+>         ,"blob"+>         ,"numeric"+>         ,"decimal"+>         ,"dec"+>         ,"smallint"+>         ,"integer"+>         ,"int"+>         ,"bigint"+>         ,"float"+>         ,"real"+>         ,"double precision"+>         ,"boolean"+>         ,"date"+>         ,"time"+>         ,"timestamp"]+>         --interval -- not allowed without interval qualifier+>         --row -- not allowed without row type body+>         -- array -- not allowed on own+>         -- multiset -- not allowed on own++>          +++>          [-- 1 single prec + 1 with multiname+>           ("char(5)", PrecTypeName [Name Nothing "char"] 5)+>          ,("char varying(5)", PrecTypeName [Name Nothing "char varying"] 5)+>          -- 1 scale+>          ,("decimal(15,2)", PrecScaleTypeName [Name Nothing "decimal"] 15 2)+>          ,("char(3 octets)"+>           ,PrecLengthTypeName [Name Nothing "char"] 3 Nothing (Just PrecOctets))+>          ,("varchar(50 characters)"+>           ,PrecLengthTypeName [Name Nothing "varchar"] 50 Nothing (Just PrecCharacters))+>          -- lob prec + with multiname+>          ,("blob(3M)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecM) Nothing)+>          ,("blob(3T)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecT) Nothing)+>          ,("blob(3P)", PrecLengthTypeName [Name Nothing "blob"] 3 (Just PrecP) Nothing)+>          ,("blob(4M characters) "+>           ,PrecLengthTypeName [Name Nothing "blob"] 4 (Just PrecM) (Just PrecCharacters))+>          ,("blob(6G octets) "+>           ,PrecLengthTypeName [Name Nothing "blob"] 6 (Just PrecG) (Just PrecOctets))+>          ,("national character large object(7K) "+>           ,PrecLengthTypeName [Name Nothing "national character large object"]+>                7 (Just PrecK) Nothing)+>          -- 1 with and without tz+>          ,("time with time zone"+>           ,TimeTypeName [Name Nothing "time"] Nothing True)+>          ,("datetime(3) without time zone"+>           ,TimeTypeName [Name Nothing "datetime"] (Just 3) False)+>          -- chars: (single/multiname) x prec x charset x collate+>          -- 1111+>          ,("char varying(5) character set something collate something_insensitive"+>           ,CharTypeName [Name Nothing "char varying"] (Just 5)+>            [Name Nothing "something"] [Name Nothing "something_insensitive"])+>           -- 0111+>          ,("char(5) character set something collate something_insensitive"+>           ,CharTypeName [Name Nothing "char"] (Just 5)+>            [Name Nothing "something"] [Name Nothing "something_insensitive"])++>           -- 1011+>          ,("char varying character set something collate something_insensitive"+>           ,CharTypeName [Name Nothing "char varying"] Nothing+>            [Name Nothing "something"] [Name Nothing "something_insensitive"])+>           -- 0011+>          ,("char character set something collate something_insensitive"+>           ,CharTypeName [Name Nothing "char"] Nothing+>            [Name Nothing "something"] [Name Nothing "something_insensitive"])++>           -- 1101+>          ,("char varying(5) collate something_insensitive"+>           ,CharTypeName [Name Nothing "char varying"] (Just 5)+>            [] [Name Nothing "something_insensitive"])+>           -- 0101+>          ,("char(5) collate something_insensitive"+>           ,CharTypeName [Name Nothing "char"] (Just 5)+>            [] [Name Nothing "something_insensitive"])+>           -- 1001+>          ,("char varying collate something_insensitive"+>           ,CharTypeName [Name Nothing "char varying"] Nothing+>            [] [Name Nothing "something_insensitive"])+>           -- 0001+>          ,("char collate something_insensitive"+>           ,CharTypeName [Name Nothing "char"] Nothing+>            [] [Name Nothing "something_insensitive"])++>          -- 1110+>          ,("char varying(5) character set something"+>           ,CharTypeName [Name Nothing "char varying"] (Just 5)+>            [Name Nothing "something"] [])+>           -- 0110+>          ,("char(5) character set something"+>           ,CharTypeName [Name Nothing "char"] (Just 5)+>            [Name Nothing "something"] [])+>           -- 1010+>          ,("char varying character set something"+>           ,CharTypeName [Name Nothing "char varying"] Nothing+>            [Name Nothing "something"] [])+>           -- 0010+>          ,("char character set something"+>           ,CharTypeName [Name Nothing "char"] Nothing+>            [Name Nothing "something"] [])+>           -- 1100+>          ,("char varying character set something"+>           ,CharTypeName [Name Nothing "char varying"] Nothing+>            [Name Nothing "something"] [])++>          -- single row field, two row field+>          ,("row(a int)", RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])])+>          ,("row(a int,b char)"+>           ,RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])+>                        ,(Name Nothing "b", TypeName [Name Nothing "char"])])+>          -- interval each type raw+>          ,("interval year"+>           ,IntervalTypeName (Itf "year" Nothing) Nothing)+>          -- one type with single suffix+>          -- one type with double suffix+>          ,("interval year(2)"+>           ,IntervalTypeName (Itf "year" $ Just (2,Nothing)) Nothing)+>          ,("interval second(2,5)"+>           ,IntervalTypeName (Itf "second" $ Just (2,Just 5)) Nothing)+>          -- a to b with raw+>          -- a to b with single suffix+>          ,("interval year to month"+>           ,IntervalTypeName (Itf "year" Nothing)+>                             (Just $ Itf "month" Nothing))+>          ,("interval year(4) to second(2,3)"+>           ,IntervalTypeName (Itf "year" $ Just (4,Nothing))+>                             (Just $ Itf "second" $ Just (2, Just 3)))+>          ]++Now test each variation in both cast expression and typed literal+expression++> typeNameTests :: TestItem+> typeNameTests = Group "type names"+>     [Group "type names" $ map (uncurry (TestScalarExpr ansi2011))+>                           $ concatMap makeSimpleTests $ fst typeNames+>     ,Group "generated casts" $ map (uncurry (TestScalarExpr ansi2011))+>                           $ concatMap makeCastTests $ fst typeNames+>     ,Group "generated typename" $ map (uncurry (TestScalarExpr ansi2011))+>                           $ concatMap makeTests $ snd typeNames]+>   where+>     makeSimpleTests (ctn, stn) =+>         [(ctn ++ " 'test'", TypedLit stn "test")+>         ]+>     makeCastTests (ctn, stn) =+>         [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "'" "'" "test") stn)+>         ]+>     makeTests a = makeSimpleTests a ++ makeCastTests a+++== 6.2 <field definition>++Function+Define a field of a row type.++<field definition> ::= <field name> <data type>++> fieldDefinition :: TestItem+> fieldDefinition = Group "field definition"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("cast('(1,2)' as row(a int,b char))"+>      ,Cast (StringLit "'" "'" "(1,2)")+>      $ RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])+>                    ,(Name Nothing "b", TypeName [Name Nothing "char"])])]++== 6.3 <value expression primary>++Function+Specify a value that is syntactically self-delimited.++<value expression primary> ::=+    <parenthesized value expression>+  | <nonparenthesized value expression primary>++<parenthesized value expression> ::=+  <left paren> <value expression> <right paren>++<nonparenthesized value expression primary> ::=+       <unsigned value specification>+     | <column reference>+     | <set function specification>+     | <window function>+     | <nested window function>+     | <scalar subquery>+     | <case expression>+     | <cast specification>+     | <field reference>+     | <subtype treatment>+     | <method invocation>+     | <static method invocation>+     | <new specification>+     | <attribute or method reference>+     | <reference resolution>+     | <collection value constructor>+     | <array element reference>+     | <multiset element reference>+     | <next value expression>+     | <routine invocation>++<collection value constructor> ::=+    <array value constructor>+  | <multiset value constructor>++> valueExpressions :: TestItem+> valueExpressions = Group "value expressions"+>     [generalValueSpecification+>     ,parameterSpecification+>     ,contextuallyTypedValueSpecification+>     ,identifierChain+>     ,columnReference+>     ,setFunctionSpecification+>     ,windowFunction+>     ,nestedWindowFunction+>     ,caseExpression+>     ,castSpecification+>     ,nextScalarExpression+>     ,fieldReference+>     ,arrayElementReference+>     ,multisetElementReference+>     ,numericScalarExpression+>     ,numericValueFunction+>     ,stringScalarExpression+>     ,stringValueFunction+>     ,datetimeScalarExpression+>     ,datetimeValueFunction+>     ,intervalScalarExpression+>     ,intervalValueFunction+>     ,booleanScalarExpression+>     ,arrayScalarExpression+>     ,arrayValueFunction+>     ,arrayValueConstructor+>     ,multisetScalarExpression+>     ,multisetValueFunction+>     ,multisetValueConstructor+>     ,parenthesizedScalarExpression+>     ]++> parenthesizedScalarExpression :: TestItem+> parenthesizedScalarExpression = Group "parenthesized value expression"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("(3)", Parens (NumLit "3"))+>     ,("((3))", Parens $ Parens (NumLit "3"))+>     ]++== 6.4 <value specification> and <target specification>++Function+Specify one or more values, host parameters, SQL parameters, dynamic parameters, or host variables.++<value specification> ::= <literal> | <general value specification>++<unsigned value specification> ::=+    <unsigned literal>+  | <general value specification>++ <general value specification> ::=+    <host parameter specification>+  | <SQL parameter reference>+  | <dynamic parameter specification>+  | <embedded variable specification>+  | <current collation specification>+  | CURRENT_CATALOG+  | CURRENT_DEFAULT_TRANSFORM_GROUP+  | CURRENT_PATH+  | CURRENT_ROLE+  | CURRENT_SCHEMA+  | CURRENT_TRANSFORM_GROUP_FOR_TYPE <path-resolved user-defined type name>+  | CURRENT_USER+  | SESSION_USER+  | SYSTEM_USER+  | USER+  | VALUE++> generalValueSpecification :: TestItem+> generalValueSpecification = Group "general value specification"+>     $ map (uncurry (TestScalarExpr ansi2011)) $+>     map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"+>                ,"CURRENT_PATH"+>                ,"CURRENT_ROLE"+>                ,"CURRENT_USER"+>                ,"SESSION_USER"+>                ,"SYSTEM_USER"+>                ,"USER"+>                ,"VALUE"]+>   where+>     mkIden nm = (nm,Iden [Name Nothing nm])++TODO: add the missing bits++<simple value specification> ::=+    <literal>+  | <host parameter name>+  | <SQL parameter reference>+  | <embedded variable name>++<target specification> ::=+    <host parameter specification>+  | <SQL parameter reference>+  | <column reference>+  | <target array element specification>+  | <dynamic parameter specification>+  | <embedded variable specification>++<simple target specification> ::=+    <host parameter name>+  | <SQL parameter reference>+  | <column reference>+  | <embedded variable name>++<host parameter specification> ::=+  <host parameter name> [ <indicator parameter> ]++<dynamic parameter specification> ::= <question mark>++<embedded variable specification> ::=+  <embedded variable name> [ <indicator variable> ]++<indicator variable> ::= [ INDICATOR ] <embedded variable name>++<indicator parameter> ::= [ INDICATOR ] <host parameter name>++<target array element specification> ::=+  <target array reference>+      <left bracket or trigraph> <simple value specification> <right bracket or trigraph>++<target array reference> ::= <SQL parameter reference> | <column reference>++> parameterSpecification :: TestItem+> parameterSpecification = Group "parameter specification"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [(":hostparam", HostParameter ":hostparam" Nothing)+>     ,(":hostparam indicator :another_host_param"+>      ,HostParameter ":hostparam" $ Just ":another_host_param")+>     ,("?", Parameter)+>     ,(":h[3]", Array (HostParameter ":h" Nothing) [NumLit "3"])+>     ]++<current collation specification> ::=+  COLLATION FOR <left paren> <string value expression> <right paren>++TODO: review the modules stuff++== 6.5 <contextually typed value specification>++Function+Specify a value whose data type is to be inferred from its context.++<contextually typed value specification> ::=+    <implicitly typed value specification>+  | <default specification>++<implicitly typed value specification> ::=+    <null specification>+  | <empty specification>++<null specification> ::= NULL++<empty specification> ::=+    ARRAY <left bracket or trigraph> <right bracket or trigraph>+  | MULTISET <left bracket or trigraph> <right bracket or trigraph>++<default specification> ::= DEFAULT++> contextuallyTypedValueSpecification :: TestItem+> contextuallyTypedValueSpecification =+>     Group "contextually typed value specification"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("null", Iden [Name Nothing "null"])+>     ,("array[]", Array (Iden [Name Nothing "array"]) [])+>     ,("multiset[]", MultisetCtor [])+>     ,("default", Iden [Name Nothing "default"])+>     ]++== 6.6 <identifier chain>++Function+Disambiguate a <period>-separated chain of identifiers.++<identifier chain> ::= <identifier> [ { <period> <identifier> }... ]++<basic identifier chain> ::= <identifier chain>++> identifierChain :: TestItem+> identifierChain = Group "identifier chain"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("a.b", Iden [Name Nothing "a",Name Nothing "b"])]++== 6.7 <column reference>++Function+Reference a column.++<column reference> ::=+    <basic identifier chain>+  | MODULE <period> <qualified identifier> <period> <column name>++> columnReference :: TestItem+> columnReference = Group "column reference"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("module.a.b", Iden [Name Nothing "module",Name Nothing "a",Name Nothing "b"])]++== 6.8 <SQL parameter reference>++Function+Reference an SQL parameter.++<SQL parameter reference> ::= <basic identifier chain>++== 6.9 <set function specification>++Function+Specify a value derived by the application of a function to an argument.++<set function specification> ::= <aggregate function> | <grouping operation>++<grouping operation> ::=+  GROUPING <left paren> <column reference>+      [ { <comma> <column reference> }... ] <right paren>++> setFunctionSpecification :: TestItem+> setFunctionSpecification = Group "set function specification"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\+>       \   GROUPING(SalesQuota) AS Grouping\n\+>       \FROM Sales.SalesPerson\n\+>       \GROUP BY ROLLUP(SalesQuota);"+>      ,makeSelect+>       {qeSelectList = [(Iden [Name Nothing "SalesQuota"],Nothing)+>                       ,(App [Name Nothing "SUM"] [Iden [Name Nothing "SalesYTD"]]+>                        ,Just (Name Nothing "TotalSalesYTD"))+>                       ,(App [Name Nothing "GROUPING"] [Iden [Name Nothing "SalesQuota"]]+>                        ,Just (Name Nothing "Grouping"))]+>       ,qeFrom = [TRSimple [Name Nothing "Sales",Name Nothing "SalesPerson"]]+>       ,qeGroupBy = [Rollup [SimpleGroup (Iden [Name Nothing "SalesQuota"])]]})+>     ]++== 6.10 <window function>++Function+Specify a window function.++<window function> ::=+  <window function type> OVER <window name or specification>++<window function type> ::=+    <rank function type> <left paren> <right paren>+  | ROW_NUMBER <left paren> <right paren>+  | <aggregate function>+  | <ntile function>+  | <lead or lag function>+  | <first or last value function>+  | <nth value function>++<rank function type> ::= RANK | DENSE_RANK | PERCENT_RANK | CUME_DIST++<ntile function> ::= NTILE <left paren> <number of tiles> <right paren>++<number of tiles> ::=+    <simple value specification>+  | <dynamic parameter specification>++<lead or lag function> ::=+  <lead or lag> <left paren> <lead or lag extent>+      [ <comma> <offset> [ <comma> <default expression> ] ] <right paren>+      [ <null treatment> ]++<lead or lag> ::= LEAD | LAG++<lead or lag extent> ::= <value expression>++<offset> ::= <exact numeric literal>++<default expression> ::= <value expression>++<null treatment> ::= RESPECT NULLS | IGNORE NULLS++<first or last value function> ::=+  <first or last value> <left paren> <value expression> <right paren> [ <null treatment>+  ]++<first or last value> ::= FIRST_VALUE | LAST_VALUE++<nth value function> ::=+  NTH_VALUE <left paren> <value expression> <comma> <nth row> <right paren>+      [ <from first or last> ] [ <null treatment> ]++<nth row> ::= <simple value specification> | <dynamic parameter specification>++<from first or last> ::= FROM FIRST | FROM LAST++<window name or specification> ::=+    <window name>+  | <in-line window specification>++<in-line window specification> ::= <window specification>++> windowFunction :: TestItem+> windowFunction = Group "window function"+>     [-- todo: window function+>     ]++== 6.11 <nested window function>++Function++Specify a function nested in an aggregated argument of an+<aggregate function> simply contained in a <window function>.++<nested window function> ::=+    <nested row number function>+  | <value_of expression at row>++<nested row number function> ::=+  ROW_NUMBER <left paren> <row marker> <right paren>++<value_of expression at row> ::=+  VALUE_OF <left paren> <value expression> AT <row marker expression>+      [ <comma> <value_of default value> ] <right paren>++<row marker> ::=+    BEGIN_PARTITION+  | BEGIN_FRAME+  | CURRENT_ROW+  | FRAME_ROW+  | END_FRAME+  | END_PARTITION++<row marker expression> ::= <row marker> [ <row marker delta> ]++<row marker delta> ::=+    <plus sign> <row marker offset>+  | <minus sign> <row marker offset>++<row marker offset> ::=+    <simple value specification>+  | <dynamic parameter specification>++<value_of default value> ::= <value expression>++> nestedWindowFunction :: TestItem+> nestedWindowFunction = Group "nested window function"+>     [-- todo: nested window function+>     ]+++== 6.12 <case expression>++Function+Specify a conditional value.++<case expression> ::= <case abbreviation> | <case specification>++<case abbreviation> ::=+    NULLIF <left paren> <value expression> <comma> <value expression> <right paren>+  | COALESCE <left paren> <value expression>+      { <comma> <value expression> }... <right paren>++<case specification> ::= <simple case> | <searched case>++<simple case> ::=+  CASE <case operand> <simple when clause>... [ <else clause> ] END++<searched case> ::= CASE <searched when clause>... [ <else clause> ] END++<simple when clause> ::= WHEN <when operand list> THEN <result>++<searched when clause> ::= WHEN <search condition> THEN <result>++<else clause> ::= ELSE <result>++<case operand> ::= <row value predicand> | <overlaps predicate part 1>++<when operand list> ::= <when operand> [ { <comma> <when operand> }... ]++<when operand> ::=+    <row value predicand>+  | <comparison predicate part 2>+  | <between predicate part 2>+  | <in predicate part 2>+  | <character like predicate part 2>+  | <octet like predicate part 2>+  | <similar predicate part 2>+  | <regex like predicate part 2>+  | <null predicate part 2>+  | <quantified comparison predicate part 2>+  | <normalized predicate part 2>+  | <match predicate part 2>+  | <overlaps predicate part 2>+  | <distinct predicate part 2>+  | <member predicate part 2>+  | <submultiset predicate part 2>+  | <set predicate part 2>+  | <type predicate part 2>++I haven't seen these part 2 style when operands in the wild. It+doesn't even allow all the binary operators here. We will allow them+all, and parser and represent these expressions by considering all the+binary ops as unary prefix ops.++<result> ::= <result expression> | NULL++<result expression> ::= <value expression>++> caseExpression :: TestItem+> caseExpression = Group "case expression"+>     [-- todo: case expression+>     ]++== 6.13 <cast specification>++Function+Specify a data conversion.++<cast specification> ::=+     CAST <left paren> <cast operand> AS <cast target> <right paren>++<cast operand> ::= <value expression> | <implicitly typed value specification>++<cast target> ::= <domain name> | <data type>++> castSpecification :: TestItem+> castSpecification = Group "cast specification"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("cast(a as int)"+>      ,Cast (Iden [Name Nothing "a"]) (TypeName [Name Nothing "int"]))+>     ]++== 6.14 <next value expression>++Function+Return the next value of a sequence generator.++<next value expression> ::= NEXT VALUE FOR <sequence generator name>++> nextScalarExpression :: TestItem+> nextScalarExpression = Group "next value expression"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("next value for a.b", NextValueFor [Name Nothing "a", Name Nothing "b"])+>     ]++== 6.15 <field reference>++Function+Reference a field of a row value.++<field reference> ::= <value expression primary> <period> <field name>++> fieldReference :: TestItem+> fieldReference = Group "field reference"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("f(something).a"+>       ,BinOp (App [Name Nothing "f"] [Iden [Name Nothing "something"]])+>        [Name Nothing "."]+>        (Iden [Name Nothing "a"]))+>     ]++TODO: try all possible value expression syntax variations followed by+field reference++== 6.16 <subtype treatment>++Function+Modify the declared type of an expression.++<subtype treatment> ::=+  TREAT <left paren> <subtype operand> AS <target subtype> <right paren>++<subtype operand> ::= <value expression>++<target subtype> ::= <path-resolved user-defined type name> | <reference type>++todo: subtype treatment++== 6.17 <method invocation>++Function+Reference an SQL-invoked method of a user-defined type value.++<method invocation> ::= <direct invocation> | <generalized invocation>++<direct invocation> ::=+  <value expression primary> <period> <method name> [ <SQL argument list> ]++<generalized invocation> ::=+  <left paren> <value expression primary> AS <data type> <right paren>+      <period> <method name> [ <SQL argument list> ]++<method selection> ::= <routine invocation>++<constructor method selection> ::= <routine invocation>++todo: method invocation++== 6.18 <static method invocation>++Function+Invoke a static method.++<static method invocation> ::=+  <path-resolved user-defined type name> <double colon> <method name>+      [ <SQL argument list> ]++<static method selection> ::= <routine invocation>++todo: static method invocation++== 6.19 <new specification>++Function+Invoke a method on a newly-constructed value of a structured type.++<new specification> ::=+  NEW <path-resolved user-defined type name> <SQL argument list>++<new invocation> ::= <method invocation> | <routine invocation>++todo: new specification++== 6.20 <attribute or method reference>++Function+Return a value acquired by accessing a column of the row identified by+a value of a reference type or by invoking an SQL-invoked method.++<attribute or method reference> ::=+  <value expression primary> <dereference operator> <qualified identifier>+      [ <SQL argument list> ]++<dereference operator> ::= <right arrow>++todo: attribute of method reference++== 6.21 <dereference operation>++Function+Access a column of the row identified by a value of a reference type.++<dereference operation> ::=+  <reference value expression> <dereference operator> <attribute name>++todo: deference operation++== 6.22 <method reference>++Function+Return a value acquired from invoking an SQL-invoked routine that is a method.++<method reference> ::=+  <value expression primary> <dereference operator> <method name> <SQL argument list>++todo: method reference++== 6.23 <reference resolution>++Function+Obtain the value referenced by a reference value.++<reference resolution> ::=+  DEREF <left paren> <reference value expression> <right paren>++todo: reference resolution++== 6.24 <array element reference>++Function+Return an element of an array.++<array element reference> ::=+  <array value expression>+      <left bracket or trigraph> <numeric value expression> <right bracket or trigraph>++> arrayElementReference :: TestItem+> arrayElementReference = Group "array element reference"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("something[3]"+>      ,Array (Iden [Name Nothing "something"]) [NumLit "3"])+>     ,("(something(a))[x]"+>       ,Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))+>         [Iden [Name Nothing "x"]])+>     ,("(something(a))[x][y] "+>       ,Array (+>         Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))+>         [Iden [Name Nothing "x"]])+>         [Iden [Name Nothing "y"]])+>     ]++== 6.25 <multiset element reference>++Function+Return the sole element of a multiset of one element.++<multiset element reference> ::=+  ELEMENT <left paren> <multiset value expression> <right paren>++> multisetElementReference :: TestItem+> multisetElementReference = Group "multisetElementReference"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("element(something)"+>      ,App [Name Nothing "element"] [Iden [Name Nothing "something"]])+>     ]++== 6.26 <value expression>++Function+Specify a value.++<value expression> ::=+    <common value expression>+  | <boolean value expression>+  | <row value expression>++<common value expression> ::=+       <numeric value expression>+     | <string value expression>+     | <datetime value expression>+     | <interval value expression>+     | <user-defined type value expression>+     | <reference value expression>+     | <collection value expression>++<user-defined type value expression> ::= <value expression primary>++<reference value expression> ::= <value expression primary>++<collection value expression> ::=+    <array value expression>+  | <multiset value expression>++== 6.27 <numeric value expression>++Function+Specify a numeric value.++<numeric value expression> ::=+    <term>+  | <numeric value expression> <plus sign> <term>+  | <numeric value expression> <minus sign> <term>++<term> ::= <factor> | <term> <asterisk> <factor> | <term> <solidus> <factor>++<factor> ::= [ <sign> ] <numeric primary>++<numeric primary> ::= <value expression primary> | <numeric value function>++> numericScalarExpression :: TestItem+> numericScalarExpression = Group "numeric value expression"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("a + b", binOp "+")+>     ,("a - b", binOp "-")+>     ,("a * b", binOp "*")+>     ,("a / b", binOp "/")+>     ,("+a", prefOp "+")+>     ,("-a", prefOp "-")+>     ]+>   where+>     binOp o = BinOp (Iden [Name Nothing "a"]) [Name Nothing o] (Iden [Name Nothing "b"])+>     prefOp o = PrefixOp [Name Nothing o] (Iden [Name Nothing "a"])++TODO: precedence and associativity tests (need to review all operators+for what precendence and associativity tests to write)++== 6.28 <numeric value function>++Function+Specify a function yielding a value of type numeric.++<numeric value function> ::=+    <position expression>+  | <regex occurrences function>+  | <regex position expression>+  | <extract expression>+  | <length expression>+  | <cardinality expression>+  | <max cardinality expression>+  | <absolute value expression>+  | <modulus expression>+  | <natural logarithm>+  | <exponential function>+  | <power function>+  | <square root>+  | <floor function>+  | <ceiling function>+  | <width bucket function>+++> numericValueFunction :: TestItem+> numericValueFunction = Group "numeric value function"+>     [-- todo: numeric value function+>     ]++<position expression> ::=+    <character position expression>+  | <binary position expression>++<regex occurrences function> ::=+  OCCURRENCES_REGEX <left paren>+      <XQuery pattern> [ FLAG <XQuery option flag> ]+      IN <regex subject string>+      [ FROM <start position> ]+      [ USING <char length units> ]+      <right paren>++<XQuery pattern> ::= <character value expression>++<XQuery option flag> ::= <character value expression>++<regex subject string> ::= <character value expression>++<regex position expression> ::=+  POSITION_REGEX <left paren>+      [ <regex position start or after> ]+      <XQuery pattern> [ FLAG <XQuery option flag> ]+      IN <regex subject string>+      [ FROM <start position> ]+      [ USING <char length units> ]+      [ OCCURRENCE <regex occurrence> ]+      [ GROUP <regex capture group> ]+      <right paren>++<regex position start or after> ::= START | AFTER++<regex occurrence> ::= <numeric value expression>++<regex capture group> ::= <numeric value expression>++<character position expression> ::=+  POSITION <left paren> <character value expression 1> IN <character value expression 2>+      [ USING <char length units> ] <right paren>++<character value expression 1> ::= <character value expression>++<character value expression 2> ::= <character value expression>++<binary position expression> ::=+  POSITION <left paren> <binary value expression> IN <binary value expression> <right paren>++<length expression> ::= <char length expression> | <octet length expression>++<char length expression> ::=+  { CHAR_LENGTH | CHARACTER_LENGTH } <left paren> <character value expression>+      [ USING <char length units> ] <right paren>++<octet length expression> ::=+  OCTET_LENGTH <left paren> <string value expression> <right paren>++<extract expression> ::=+  EXTRACT <left paren> <extract field> FROM <extract source> <right paren>++<extract field> ::= <primary datetime field> | <time zone field>++<time zone field> ::= TIMEZONE_HOUR | TIMEZONE_MINUTE++<extract source> ::= <datetime value expression> | <interval value expression>++<cardinality expression> ::=+  CARDINALITY <left paren> <collection value expression> <right paren>++<max cardinality expression> ::=+  ARRAY_MAX_CARDINALITY <left paren> <array value expression> <right paren>++<absolute value expression> ::=+  ABS <left paren> <numeric value expression> <right paren>++<modulus expression> ::=+  MOD <left paren> <numeric value expression dividend> <comma>+      <numeric value expression divisor> <right paren>++<numeric value expression dividend> ::= <numeric value expression>++<numeric value expression divisor> ::= <numeric value expression>++<natural logarithm> ::=+  LN <left paren> <numeric value expression> <right paren>++<exponential function> ::=+  EXP <left paren> <numeric value expression> <right paren>++<power function> ::=+  POWER <left paren> <numeric value expression base> <comma>+      <numeric value expression exponent> <right paren>++<numeric value expression base> ::= <numeric value expression>++<numeric value expression exponent> ::= <numeric value expression>++<square root> ::= SQRT <left paren> <numeric value expression> <right paren>++<floor function> ::=+  FLOOR <left paren> <numeric value expression> <right paren>++<ceiling function> ::=+  { CEIL | CEILING } <left paren> <numeric value expression> <right paren>++<width bucket function> ::=+  WIDTH_BUCKET <left paren> <width bucket operand> <comma> <width bucket bound 1> <comma>+      <width bucket bound 2> <comma> <width bucket count> <right paren>++<width bucket operand> ::= <numeric value expression>++<width bucket bound 1> ::= <numeric value expression>++<width bucket bound 2> ::= <numeric value expression>++<width bucket count> ::= <numeric value expression>++== 6.29 <string value expression>++Function+Specify a character string value or a binary string value.++<string value expression> ::=+    <character value expression>+  | <binary value expression>++<character value expression> ::= <concatenation> | <character factor>++<concatenation> ::=+  <character value expression> <concatenation operator> <character factor>++<character factor> ::= <character primary> [ <collate clause> ]++<character primary> ::= <value expression primary> | <string value function>++<binary value expression> ::= <binary concatenation> | <binary factor>++<binary factor> ::= <binary primary>++<binary primary> ::= <value expression primary> | <string value function>++<binary concatenation> ::=+  <binary value expression> <concatenation operator> <binary factor>++> stringScalarExpression :: TestItem+> stringScalarExpression = Group "string value expression"+>     [-- todo: string value expression+>     ]++== 6.30 <string value function>++Function+Specify a function yielding a value of type character string or binary string.++<string value function> ::=+    <character value function>+  | <binary value function>++<character value function> ::=+    <character substring function>+  | <regular expression substring function>+  | <regex substring function>+  | <fold>+  | <transcoding>+  | <character transliteration>+  | <regex transliteration>+  | <trim function>+  | <character overlay function>+  | <normalize function>+  | <specific type method>++> stringValueFunction :: TestItem+> stringValueFunction = Group "string value function"+>     [-- todo: string value function+>     ]++<character substring function> ::=+  SUBSTRING <left paren> <character value expression> FROM <start position>+      [ FOR <string length> ] [ USING <char length units> ] <right paren>++<regular expression substring function> ::=+  SUBSTRING <left paren> <character value expression> SIMILAR <character value expression>+      ESCAPE <escape character> <right paren>++<regex substring function> ::=+  SUBSTRING_REGEX <left paren>+      <XQuery pattern> [ FLAG <XQuery option flag> ]+      IN <regex subject string>+      [ FROM <start position> ]+      [ USING <char length units> ]+      [ OCCURRENCE <regex occurrence> ]+      [ GROUP <regex capture group> ]+      <right paren>++<fold> ::=+  { UPPER | LOWER } <left paren> <character value expression> <right paren>++<transcoding> ::=+  CONVERT <left paren> <character value expression>+      USING <transcoding name> <right paren>++<character transliteration> ::=+  TRANSLATE <left paren> <character value expression>+      USING <transliteration name> <right paren>++<regex transliteration> ::=+  TRANSLATE_REGEX <left paren>+      <XQuery pattern> [ FLAG <XQuery option flag> ]+      IN <regex subject string>+      [ WITH <XQuery replacement string> ]+      [ FROM <start position> ]+      [ USING <char length units> ]+      [ OCCURRENCE <regex transliteration occurrence> ]+      <right paren>++<XQuery replacement string> ::= <character value expression>++<regex transliteration occurrence> ::= <regex occurrence> | ALL++<trim function> ::= TRIM <left paren> <trim operands> <right paren>++<trim operands> ::=+  [ [ <trim specification> ] [ <trim character> ] FROM ] <trim source>++<trim source> ::= <character value expression>++<trim specification> ::= LEADING | TRAILING | BOTH++<trim character> ::= <character value expression>++<character overlay function> ::=+  OVERLAY <left paren> <character value expression> PLACING <character value expression>+      FROM <start position> [ FOR <string length> ]+      [ USING <char length units> ] <right paren>++<normalize function> ::=+  NORMALIZE <left paren> <character value expression>+      [ <comma> <normal form> [ <comma> <normalize function result length> ] ] <right paren>++<normal form> ::= NFC | NFD | NFKC | NFKD++<normalize function result length> ::=+    <character length>+  | <character large object length>++<specific type method> ::=+  <user-defined type value expression> <period> SPECIFICTYPE+      [ <left paren> <right paren> ]++<binary value function> ::=+       <binary substring function>+     | <binary trim function>+     | <binary overlay function>++<binary substring function> ::=+  SUBSTRING <left paren> <binary value expression> FROM <start position>+      [ FOR <string length> ] <right paren>++<binary trim function> ::=+  TRIM <left paren> <binary trim operands> <right paren>++<binary trim operands> ::=+  [ [ <trim specification> ] [ <trim octet> ] FROM ] <binary trim source>++<binary trim source> ::= <binary value expression>++<trim octet> ::= <binary value expression>++<binary overlay function> ::=+  OVERLAY <left paren> <binary value expression> PLACING <binary value expression>+      FROM <start position> [ FOR <string length> ] <right paren>++<start position> ::= <numeric value expression>++<string length> ::= <numeric value expression>++== 6.31 <datetime value expression>++Function+Specify a datetime value.++<datetime value expression> ::=+    <datetime term>+  | <interval value expression> <plus sign> <datetime term>+  | <datetime value expression> <plus sign> <interval term>+  | <datetime value expression> <minus sign> <interval term>++> datetimeScalarExpression :: TestItem+> datetimeScalarExpression = Group "datetime value expression"+>     [-- todo: datetime value expression+>      datetimeValueFunction +>     ]++<datetime term> ::= <datetime factor>++<datetime factor> ::= <datetime primary> [ <time zone> ]++<datetime primary> ::= <value expression primary> | <datetime value function>++<time zone> ::= AT <time zone specifier>++<time zone specifier> ::= LOCAL | TIME ZONE <interval primary>++== 6.32 <datetime value function>++Function+Specify a function yielding a value of type datetime.++<datetime value function> ::=+    <current date value function>+  | <current time value function>+  | <current timestamp value function>+  | <current local time value function>+  | <current local timestamp value function>++> datetimeValueFunction :: TestItem+> datetimeValueFunction = Group "datetime value function"+>     [-- todo: datetime value function+>     ]++<current date value function> ::= CURRENT_DATE++<current time value function> ::=+  CURRENT_TIME [ <left paren> <time precision> <right paren> ]++<current local time value function> ::=+  LOCALTIME [ <left paren> <time precision> <right paren> ]++<current timestamp value function> ::=+  CURRENT_TIMESTAMP [ <left paren> <timestamp precision> <right paren> ]++<current local timestamp value function> ::=+  LOCALTIMESTAMP [ <left paren> <timestamp precision> <right paren> ]++== 6.33 <interval value expression>++Function+Specify an interval value.++<interval value expression> ::=+    <interval term>+  | <interval value expression 1> <plus sign> <interval term 1>+  | <interval value expression 1> <minus sign> <interval term 1>+  | <left paren> <datetime value expression> <minus sign> <datetime term> <right paren>+      <interval qualifier>++> intervalScalarExpression :: TestItem+> intervalScalarExpression = Group "interval value expression"+>     [-- todo: interval value expression+>     ]+++<interval term> ::=+    <interval factor>+  | <interval term 2> <asterisk> <factor>+  | <interval term 2> <solidus> <factor>+  | <term> <asterisk> <interval factor>++<interval factor> ::= [ <sign> ] <interval primary>++<interval primary> ::=+    <value expression primary> [ <interval qualifier> ]+  | <interval value function>++<interval value expression 1> ::= <interval value expression>++<interval term 1> ::= <interval term>++<interval term 2> ::= <interval term>++== 6.34 <interval value function>++Function+Specify a function yielding a value of type interval.++<interval value function> ::= <interval absolute value function>++<interval absolute value function> ::=+  ABS <left paren> <interval value expression> <right paren>++> intervalValueFunction :: TestItem+> intervalValueFunction = Group "interval value function"+>     [-- todo: interval value function+>     ]+++== 6.35 <boolean value expression>++Function+Specify a boolean value.++<boolean value expression> ::=+    <boolean term>+  | <boolean value expression> OR <boolean term>++<boolean term> ::= <boolean factor> | <boolean term> AND <boolean factor>++<boolean factor> ::= [ NOT ] <boolean test>++<boolean test> ::= <boolean primary> [ IS [ NOT ] <truth value> ]++<truth value> ::= TRUE | FALSE | UNKNOWN++<boolean primary> ::= <predicate> | <boolean predicand>++<boolean predicand> ::=+    <parenthesized boolean value expression>+  | <nonparenthesized value expression primary>++<parenthesized boolean value expression> ::=+  <left paren> <boolean value expression> <right paren>+++> booleanScalarExpression :: TestItem+> booleanScalarExpression = Group "booleab value expression"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("a or b", BinOp a [Name Nothing "or"] b)+>     ,("a and b", BinOp a [Name Nothing "and"] b)+>     ,("not a", PrefixOp [Name Nothing "not"] a)+>     ,("a is true", postfixOp "is true")+>     ,("a is false", postfixOp "is false")+>     ,("a is unknown", postfixOp "is unknown")+>     ,("a is not true", postfixOp "is not true")+>     ,("a is not false", postfixOp "is not false")+>     ,("a is not unknown", postfixOp "is not unknown")+>     ,("(a or b)", Parens $ BinOp a [Name Nothing "or"] b)+>     ]+>   where+>     a = Iden [Name Nothing "a"]+>     b = Iden [Name Nothing "b"]+>     postfixOp nm = PostfixOp [Name Nothing nm] a++TODO: review if more tests are needed. Should at least have+precendence tests for mixed and, or and not without parens.++== 6.36 <array value expression>++Function+Specify an array value.++<array value expression> ::= <array concatenation> | <array primary>++<array concatenation> ::=+  <array value expression 1> <concatenation operator> <array primary>++<array value expression 1> ::= <array value expression>++<array primary> ::= <array value function> | <value expression primary>++> arrayScalarExpression :: TestItem+> arrayScalarExpression = Group "array value expression"+>     [-- todo: array value expression+>     ]++== 6.37 <array value function>++Function+Specify a function yielding a value of an array type.++<array value function> ::= <trim array function>++<trim array function> ::=+  TRIM_ARRAY <left paren> <array value expression> <comma> <numeric value expression>+    <right paren>++> arrayValueFunction :: TestItem+> arrayValueFunction = Group "array value function"+>     [-- todo: array value function+>     ]++== 6.38 <array value constructor>++Function+Specify construction of an array.++<array value constructor> ::=+    <array value constructor by enumeration>+  | <array value constructor by query>++<array value constructor by enumeration> ::=+  ARRAY <left bracket or trigraph> <array element list> <right bracket or trigraph>++<array element list> ::= <array element> [ { <comma> <array element> }... ]++<array element> ::= <value expression>++<array value constructor by query> ::= ARRAY <table subquery>++> arrayValueConstructor :: TestItem+> arrayValueConstructor = Group "array value constructor"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("array[1,2,3]"+>      ,Array (Iden [Name Nothing "array"])+>       [NumLit "1", NumLit "2", NumLit "3"])+>     ,("array[a,b,c]"+>      ,Array (Iden [Name Nothing "array"])+>       [Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]])+>     ,("array(select * from t)"+>       ,ArrayCtor (makeSelect+>                   {qeSelectList = [(Star,Nothing)]+>                   ,qeFrom = [TRSimple [Name Nothing "t"]]}))+>     ,("array(select * from t order by a)"+>       ,ArrayCtor (makeSelect+>                   {qeSelectList = [(Star,Nothing)]+>                   ,qeFrom = [TRSimple [Name Nothing "t"]]+>                   ,qeOrderBy = [SortSpec (Iden [Name Nothing "a"])+>                                     DirDefault NullsOrderDefault]}))+>     ]+++== 6.39 <multiset value expression>++Function+Specify a multiset value.++<multiset value expression> ::=+    <multiset term>+  | <multiset value expression> MULTISET UNION [ ALL | DISTINCT ] <multiset term>+  | <multiset value expression> MULTISET EXCEPT [ ALL | DISTINCT ] <multiset term>++<multiset term> ::=+    <multiset primary>+  | <multiset term> MULTISET INTERSECT [ ALL | DISTINCT ] <multiset primary>++<multiset primary> ::= <multiset value function> | <value expression primary>++> multisetScalarExpression :: TestItem+> multisetScalarExpression = Group "multiset value expression"+>    $ map (uncurry (TestScalarExpr ansi2011))+>    [("a multiset union b"+>     ,MultisetBinOp (Iden [Name Nothing "a"]) Union SQDefault (Iden [Name Nothing "b"]))+>    ,("a multiset union all b"+>     ,MultisetBinOp (Iden [Name Nothing "a"]) Union All (Iden [Name Nothing "b"]))+>    ,("a multiset union distinct b"+>     ,MultisetBinOp (Iden [Name Nothing "a"]) Union Distinct (Iden [Name Nothing "b"]))+>    ,("a multiset except b"+>     ,MultisetBinOp (Iden [Name Nothing "a"]) Except SQDefault (Iden [Name Nothing "b"]))+>    ,("a multiset intersect b"+>     ,MultisetBinOp (Iden [Name Nothing "a"]) Intersect SQDefault (Iden [Name Nothing "b"]))+>    ]++TODO: check precedence and associativity++== 6.40 <multiset value function>++Function+Specify a function yielding a value of a multiset type.++<multiset value function> ::= <multiset set function>++<multiset set function> ::=+  SET <left paren> <multiset value expression> <right paren>++TODO: set is now a reserved keyword. Fix the set parsing with a+special case term.++> multisetValueFunction :: TestItem+> multisetValueFunction = Group "multiset value function"+>    $ map (uncurry (TestScalarExpr ansi2011))+>    [("set(a)", App [Name Nothing "set"] [Iden [Name Nothing "a"]])+>    ]++== 6.41 <multiset value constructor>++Function+Specify construction of a multiset.++<multiset value constructor> ::=+    <multiset value constructor by enumeration>+  | <multiset value constructor by query>+  | <table value constructor by query>++<multiset value constructor by enumeration> ::=+  MULTISET <left bracket or trigraph> <multiset element list> <right bracket or trigraph>++<multiset element list> ::=+  <multiset element> [ { <comma> <multiset element> }... ]++<multiset element> ::= <value expression>++<multiset value constructor by query> ::= MULTISET <table subquery>++<table value constructor by query> ::= TABLE <table subquery>++> multisetValueConstructor :: TestItem+> multisetValueConstructor = Group "multiset value constructor"+>    $ map (uncurry (TestScalarExpr ansi2011))+>    [("multiset[a,b,c]", MultisetCtor[Iden [Name Nothing "a"]+>                                     ,Iden [Name Nothing "b"], Iden [Name Nothing "c"]])+>    ,("multiset(select * from t)", MultisetQueryCtor qe)+>    ,("table(select * from t)", MultisetQueryCtor qe)+>    ]+>   where+>     qe = makeSelect {qeSelectList = [(Star,Nothing)]+>                     ,qeFrom = [TRSimple [Name Nothing "t"]]}+++= 7 Query expressions++> queryExpressions :: TestItem+> queryExpressions = Group "query expressions"+>     [rowValueConstructor+>     ,tableValueConstructor+>     ,fromClause+>     ,tableReference+>     ,joinedTable+>     ,whereClause+>     ,groupByClause+>     ,havingClause+>     ,windowClause+>     ,querySpecification+>     ,withQueryExpression+>     ,setOpQueryExpression+>     ,explicitTableQueryExpression+>     ,orderOffsetFetchQueryExpression+>     ,searchOrCycleClause+>     ]+++== 7.1 <row value constructor>++Function+Specify a value or list of values to be constructed into a row.++<row value constructor> ::=+    <common value expression>+  | <boolean value expression>+  | <explicit row value constructor>++<explicit row value constructor> ::=+    <left paren> <row value constructor element> <comma>+        <row value constructor element list> <right paren>+  | ROW <left paren> <row value constructor element list> <right paren>+  | <row subquery>++<row value constructor element list> ::=+  <row value constructor element> [ { <comma> <row value constructor element> }... ]++<row value constructor element> ::= <value expression>++<contextually typed row value constructor> ::=+    <common value expression>+  | <boolean value expression>+  | <contextually typed value specification>+  | <left paren> <contextually typed value specification> <right paren>+  | <left paren> <contextually typed row value constructor element> <comma>+      <contextually typed row value constructor element list> <right paren>+  | ROW <left paren> <contextually typed row value constructor element list> <right paren>++<contextually typed row value constructor element list> ::=+  <contextually typed row value constructor element>+      [ { <comma> <contextually typed row value constructor element> }... ]++<contextually typed row value constructor element> ::=+    <value expression>+  | <contextually typed value specification>++<row value constructor predicand> ::=+    <common value expression>+  | <boolean predicand>+  | <explicit row value constructor>++> rowValueConstructor :: TestItem+> rowValueConstructor = Group "row value constructor"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("(a,b)"+>      ,SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])+>     ,("row(1)",App [Name Nothing "row"] [NumLit "1"])+>     ,("row(1,2)",App [Name Nothing "row"] [NumLit "1",NumLit "2"])+>     ]++== 7.2 <row value expression>++Function+Specify a row value.++<row value expression> ::=+    <row value special case>+  | <explicit row value constructor>++<table row value expression> ::=+    <row value special case>+  | <row value constructor>++<contextually typed row value expression> ::=+    <row value special case>+  | <contextually typed row value constructor>++<row value predicand> ::=+    <row value special case>+  | <row value constructor predicand>++<row value special case> ::= <nonparenthesized value expression primary>++There is nothing new here.++== 7.3 <table value constructor>++Function+Specify a set of <row value expression>s to be constructed into a table.++<table value constructor> ::= VALUES <row value expression list>++<row value expression list> ::=+  <table row value expression> [ { <comma> <table row value expression> }... ]++<contextually typed table value constructor> ::=+  VALUES <contextually typed row value expression list>++<contextually typed row value expression list> ::=+  <contextually typed row value expression>+      [ { <comma> <contextually typed row value expression> }... ]++> tableValueConstructor :: TestItem+> tableValueConstructor = Group "table value constructor"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("values (1,2), (a+b,(select count(*) from t));"+>      ,Values [[NumLit "1", NumLit "2"]+>              ,[BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]+>                      (Iden [Name Nothing "b"])+>               ,SubQueryExpr SqSq+>                (makeSelect+>                 {qeSelectList = [(App [Name Nothing "count"] [Star],Nothing)]+>                 ,qeFrom = [TRSimple [Name Nothing "t"]]})]])+>     ]++== 7.4 <table expression>++Function+Specify a table or a grouped table.++<table expression> ::=+  <from clause>+      [ <where clause> ]+      [ <group by clause> ]+      [ <having clause> ]+      [ <window clause> ]++== 7.5 <from clause>++Function+Specify a table derived from one or more tables.++<from clause> ::= FROM <table reference list>++<table reference list> ::=+  <table reference> [ { <comma> <table reference> }... ]++> fromClause :: TestItem+> fromClause = Group "fromClause"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select * from tbl1,tbl2"+>      ,makeSelect+>       {qeSelectList = [(Star, Nothing)]+>       ,qeFrom = [TRSimple [Name Nothing "tbl1"], TRSimple [Name Nothing "tbl2"]]+>       })]+++== 7.6 <table reference>++Function+Reference a table.++> tableReference :: TestItem+> tableReference = Group "table reference"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select * from t", sel)++<table reference> ::= <table factor> | <joined table>++<table factor> ::= <table primary> [ <sample clause> ]++<sample clause> ::=+  TABLESAMPLE <sample method> <left paren> <sample percentage> <right paren>+      [ <repeatable clause> ]++<sample method> ::= BERNOULLI | SYSTEM++<repeatable clause> ::= REPEATABLE <left paren> <repeat argument> <right paren>++<sample percentage> ::= <numeric value expression>++<repeat argument> ::= <numeric value expression>++<table primary> ::=+    <table or query name> [ <query system time period specification> ]+          [ [ AS ] <correlation name>+            [ <left paren> <derived column list> <right paren> ] ]+  | <derived table> [ AS ] <correlation name>+        [ <left paren> <derived column list> <right paren> ]+  | <lateral derived table> [ AS ] <correlation name>+        [ <left paren> <derived column list> <right paren> ]+  | <collection derived table> [ AS ] <correlation name>+        [ <left paren> <derived column list> <right paren> ]+  | <table function derived table> [ AS ] <correlation name>+        [ <left paren> <derived column list> <right paren> ]+  | <only spec> [ [ AS ] <correlation name>+        [ <left paren> <derived column list> <right paren> ] ]+  | <data change delta table> [ [ AS ] <correlation name>+        [ <left paren> <derived column list> <right paren> ] ]+  | <parenthesized joined table>++<query system time period specification> ::=+    FOR SYSTEM_TIME AS OF <point in time 1>+  | FOR SYSTEM_TIME BETWEEN [ ASYMMETRIC | SYMMETRIC ]+      <point in time 1> AND <point in time 2>+  | FOR SYSTEM_TIME FROM <point in time 1> TO <point in time 2>++TODO: query system time period spec++<point in time 1> ::= <point in time>++<point in time 2> ::= <point in time>++<point in time> ::= <datetime value expression>++<only spec> ::= ONLY <left paren> <table or query name> <right paren>++TODO: only++<lateral derived table> ::= LATERAL <table subquery>++<collection derived table> ::=+  UNNEST <left paren> <collection value expression>+      [ { <comma> <collection value expression> }... ] <right paren>+      [ WITH ORDINALITY ]++<table function derived table> ::=+  TABLE <left paren> <collection value expression> <right paren>++<derived table> ::= <table subquery>++<table or query name> ::= <table name> | <transition table name> | <query name>++<derived column list> ::= <column name list>++<column name list> ::= <column name> [ { <comma> <column name> }... ]++<data change delta table> ::=+  <result option> TABLE <left paren> <data change statement> <right paren>++<data change statement> ::=+    <delete statement: searched>+  | <insert statement>+  | <merge statement>+  | <update statement: searched>++<result option> ::= FINAL | NEW | OLD++<parenthesized joined table> ::=+    <left paren> <parenthesized joined table> <right paren>+  | <left paren> <joined table> <right paren>+++>     -- table or query name+>     ,("select * from t u", a sel)+>     ,("select * from t as u", a sel)+>     ,("select * from t u(a,b)", sel1 )+>     ,("select * from t as u(a,b)", sel1)+>     -- derived table TODO: realistic example+>     ,("select * from (select * from t) u"+>      ,a $ sel {qeFrom = [TRQueryExpr sel]})+>     -- lateral TODO: realistic example+>     ,("select * from lateral t"+>      ,af TRLateral sel)+>     -- TODO: bug, lateral should bind more tightly than the alias+>     --,("select * from lateral t u"+>     -- ,a $ af sel TRLateral)+>     -- collection TODO: realistic example+>      -- TODO: make it work+>     --,("select * from unnest(a)", undefined)+>     --,("select * from unnest(a,b)", undefined)+>     --,("select * from unnest(a,b) with ordinality", undefined)+>     --,("select * from unnest(a,b) with ordinality u", undefined)+>     --,("select * from unnest(a,b) with ordinality as u", undefined)+>     -- table fn TODO: realistic example+>      -- TODO: make it work+>     --,("select * from table(a)", undefined)+>     -- parens+>     ,("select * from (a join b)", jsel)+>     ,("select * from (a join b) u", a jsel)+>     ,("select * from ((a join b)) u", a $ af TRParens jsel)+>     ,("select * from ((a join b) u) u", a $ af TRParens $ a jsel)+>     ]+>   where+>     sel = makeSelect+>           {qeSelectList = [(Star, Nothing)]+>           ,qeFrom = [TRSimple [Name Nothing "t"]]}+>     af f s = s {qeFrom = map f (qeFrom s)}+>     a s = af (\x -> TRAlias x $ Alias (Name Nothing "u") Nothing) s+>     sel1 = makeSelect+>           {qeSelectList = [(Star, Nothing)]+>           ,qeFrom = [TRAlias (TRSimple [Name Nothing "t"])+>                      $ Alias (Name Nothing "u") $ Just [Name Nothing "a", Name Nothing "b"]]}+>     jsel = sel {qeFrom =+>                 [TRParens $ TRJoin (TRSimple [Name Nothing "a"])+>                                    False+>                                    JInner+>                                    (TRSimple [Name Nothing "b"])+>                                    Nothing]}++== 7.7 <joined table>++Function+Specify a table derived from a Cartesian product, inner join, or outer join.++<joined table> ::= <cross join> | <qualified join> | <natural join>++<cross join> ::= <table reference> CROSS JOIN <table factor>++<qualified join> ::=+  { <table reference> | <partitioned join table> }+      [ <join type> ] JOIN+      { <table reference> | <partitioned join table> }+      <join specification>++<partitioned join table> ::=+  <table factor> PARTITION BY+      <partitioned join column reference list>++<partitioned join column reference list> ::=+  <left paren> <partitioned join column reference>+      [ { <comma> <partitioned join column reference> }... ]+      <right paren>++<partitioned join column reference> ::= <column reference>++<natural join> ::=+  { <table reference> | <partitioned join table> }+      NATURAL [ <join type> ] JOIN+      { <table factor> | <partitioned join table> }++<join specification> ::= <join condition> | <named columns join>++<join condition> ::= ON <search condition>++<named columns join> ::= USING <left paren> <join column list> <right paren>++<join type> ::= INNER | <outer join type> [ OUTER ]++<outer join type> ::= LEFT | RIGHT | FULL++<join column list> ::= <column name list>++> joinedTable :: TestItem+> joinedTable = Group "joined table"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select * from a cross join b"+>      ,sel $ TRJoin a False JCross b Nothing)+>     ,("select * from a join b on true"+>      ,sel $ TRJoin a False JInner b+>       (Just $ JoinOn $ Iden [Name Nothing "true"]))+>     ,("select * from a join b using (c)"+>      ,sel $ TRJoin a False JInner b+>       (Just $ JoinUsing [Name Nothing "c"]))+>     ,("select * from a inner join b on true"+>      ,sel $ TRJoin a False JInner b+>       (Just $ JoinOn $ Iden [Name Nothing "true"]))+>     ,("select * from a left join b on true"+>      ,sel $ TRJoin a False JLeft b+>       (Just $ JoinOn $ Iden [Name Nothing "true"]))+>     ,("select * from a left outer join b on true"+>      ,sel $ TRJoin a False JLeft b+>       (Just $ JoinOn $ Iden [Name Nothing "true"]))+>     ,("select * from a right join b on true"+>      ,sel $ TRJoin a False JRight b+>       (Just $ JoinOn $ Iden [Name Nothing "true"]))+>     ,("select * from a full join b on true"+>      ,sel $ TRJoin a False JFull b+>       (Just $ JoinOn $ Iden [Name Nothing "true"]))+>     ,("select * from a natural join b"+>      ,sel $ TRJoin a True JInner b Nothing)+>     ,("select * from a natural inner join b"+>      ,sel $ TRJoin a True JInner b Nothing)+>     ,("select * from a natural left join b"+>      ,sel $ TRJoin a True JLeft b Nothing)+>     ,("select * from a natural left outer join b"+>      ,sel $ TRJoin a True JLeft b Nothing)+>     ,("select * from a natural right join b"+>      ,sel $ TRJoin a True JRight b Nothing)+>     ,("select * from a natural full join b"+>      ,sel $ TRJoin a True JFull b Nothing)+>     ]+>   where+>     sel t = makeSelect+>             {qeSelectList = [(Star, Nothing)]+>             ,qeFrom = [t]}+>     a = TRSimple [Name Nothing "a"]+>     b = TRSimple [Name Nothing "b"]++TODO: partitioned joins++== 7.8 <where clause>++Function++Specify a table derived by the application of a <search condition> to+the result of the preceding <from clause>.++<where clause> ::= WHERE <search condition>++> whereClause :: TestItem+> whereClause = Group "where clause"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select * from t where a = 5"+>     ,makeSelect+>      {qeSelectList = [(Star,Nothing)]+>      ,qeFrom = [TRSimple [Name Nothing "t"]]+>      ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})]++== 7.9 <group by clause>++Function++Specify a grouped table derived by the application of the <group by+clause> to the result of the previously specified clause.++<group by clause> ::= GROUP BY [ <set quantifier> ] <grouping element list>++<grouping element list> ::=+  <grouping element> [ { <comma> <grouping element> }... ]++<grouping element> ::=+    <ordinary grouping set>+  | <rollup list>+  | <cube list>+  | <grouping sets specification>+  | <empty grouping set>++<ordinary grouping set> ::=+    <grouping column reference>+  | <left paren> <grouping column reference list> <right paren>++<grouping column reference> ::= <column reference> [ <collate clause> ]++<grouping column reference list> ::=+  <grouping column reference> [ { <comma> <grouping column reference> }... ]++<rollup list> ::=+  ROLLUP <left paren> <ordinary grouping set list> <right paren>++<ordinary grouping set list> ::=+  <ordinary grouping set> [ { <comma> <ordinary grouping set> }... ]++<cube list> ::= CUBE <left paren> <ordinary grouping set list> <right paren>++<grouping sets specification> ::=+  GROUPING SETS <left paren> <grouping set list> <right paren>++<grouping set list> ::= <grouping set> [ { <comma> <grouping set> }... ]++<grouping set> ::=+    <ordinary grouping set>+  | <rollup list>+  | <cube list>+  | <grouping sets specification>+  | <empty grouping set>++<empty grouping set> ::= <left paren> <right paren>+++> groupByClause :: TestItem+> groupByClause = Group "group by clause"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select a,sum(x) from t group by a"+>      ,qe [SimpleGroup $ Iden [Name Nothing "a"]])+>      ,("select a,sum(x) from t group by a collate c"+>      ,qe [SimpleGroup $ Collate (Iden [Name Nothing "a"]) [Name Nothing "c"]])+>     ,("select a,b,sum(x) from t group by a,b"+>      ,qex [SimpleGroup $ Iden [Name Nothing "a"]+>           ,SimpleGroup $ Iden [Name Nothing "b"]])+>     -- todo: group by set quantifier+>     --,("select a,sum(x) from t group by distinct a"+>     --,undefined)+>     --,("select a,sum(x) from t group by all a"+>     -- ,undefined)+>     ,("select a,b,sum(x) from t group by rollup(a,b)"+>      ,qex [Rollup [SimpleGroup $ Iden [Name Nothing "a"]+>                   ,SimpleGroup $ Iden [Name Nothing "b"]]])+>     ,("select a,b,sum(x) from t group by cube(a,b)"+>      ,qex [Cube [SimpleGroup $ Iden [Name Nothing "a"]+>                 ,SimpleGroup $ Iden [Name Nothing "b"]]])+>     ,("select a,b,sum(x) from t group by grouping sets((),(a,b))"+>      ,qex [GroupingSets [GroupingParens []+>                         ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]+>                                         ,SimpleGroup $ Iden [Name Nothing "b"]]]])+>     ,("select sum(x) from t group by ()"+>      ,let x = qe [GroupingParens []]+>       in x {qeSelectList = tail $ qeSelectList x})+>     ]+>   where+>     qe g = makeSelect+>            {qeSelectList = [(Iden [Name Nothing "a"], Nothing)+>                            ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]+>            ,qeFrom = [TRSimple [Name Nothing "t"]]+>            ,qeGroupBy = g}+>     qex g = let x = qe g+>             in x {qeSelectList = let [a,b] = qeSelectList x+>                                  in [a,(Iden [Name Nothing "b"],Nothing),b]}++== 7.10 <having clause>++Function++Specify a grouped table derived by the elimination of groups that do+not satisfy a <search condition>.++<having clause> ::= HAVING <search condition>++> havingClause :: TestItem+> havingClause = Group "having clause"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select a,sum(x) from t group by a having sum(x) > 1000"+>      ,makeSelect+>       {qeSelectList = [(Iden [Name Nothing "a"], Nothing)+>                       ,(App [Name Nothing "sum"] [Iden [Name Nothing "x"]], Nothing)]+>       ,qeFrom = [TRSimple [Name Nothing "t"]]+>       ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]+>       ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "x"]])+>                                [Name Nothing ">"]+>                                (NumLit "1000")})+>     ]++== 7.11 <window clause>++Function+Specify one or more window definitions.++<window clause> ::= WINDOW <window definition list>++<window definition list> ::=+  <window definition> [ { <comma> <window definition> }... ]++<window definition> ::= <new window name> AS <window specification>++<new window name> ::= <window name>++<window specification> ::=+  <left paren> <window specification details> <right paren>++<window specification details> ::=+  [ <existing window name> ]+      [ <window partition clause> ]+      [ <window order clause> ]+      [ <window frame clause> ]++<existing window name> ::= <window name>++<window partition clause> ::=+  PARTITION BY <window partition column reference list>++<window partition column reference list> ::=+  <window partition column reference>+      [ { <comma> <window partition column reference> }... ]++<window partition column reference> ::= <column reference> [ <collate clause> ]++<window order clause> ::= ORDER BY <sort specification list>++<window frame clause> ::=+  <window frame units> <window frame extent>+      [ <window frame exclusion> ]++<window frame units> ::= ROWS | RANGE | GROUPS++<window frame extent> ::= <window frame start> | <window frame between>++<window frame start> ::=+    UNBOUNDED PRECEDING+  | <window frame preceding>+  | CURRENT ROW++<window frame preceding> ::= <unsigned value specification> PRECEDING++<window frame between> ::=+  BETWEEN <window frame bound 1> AND <window frame bound 2>++<window frame bound 1> ::= <window frame bound>++<window frame bound 2> ::= <window frame bound>++<window frame bound> ::=+    <window frame start>+  | UNBOUNDED FOLLOWING+  | <window frame following>++<window frame following> ::= <unsigned value specification> FOLLOWING++<window frame exclusion> ::=+    EXCLUDE CURRENT ROW+  | EXCLUDE GROUP+  | EXCLUDE TIES+  | EXCLUDE NO OTHERS++> windowClause :: TestItem+> windowClause = Group "window clause"+>     [-- todo: window clause+>     ]++== 7.12 <query specification>++Function+Specify a table derived from the result of a <table expression>.++<query specification> ::=+  SELECT [ <set quantifier> ] <select list> <table expression>++<select list> ::=+    <asterisk>+  | <select sublist> [ { <comma> <select sublist> }... ]++<select sublist> ::= <derived column> | <qualified asterisk>++<qualified asterisk> ::=+    <asterisked identifier chain> <period> <asterisk>+  | <all fields reference>++<asterisked identifier chain> ::=+  <asterisked identifier> [ { <period> <asterisked identifier> }... ]++<asterisked identifier> ::= <identifier>++<derived column> ::= <value expression> [ <as clause> ]++<as clause> ::= [ AS ] <column name>++<all fields reference> ::=+  <value expression primary> <period> <asterisk>+      [ AS <left paren> <all fields column name list> <right paren> ]++<all fields column name list> ::= <column name list>++> querySpecification :: TestItem+> querySpecification = Group "query specification"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select a from t",qe)+>     ,("select all a from t",qe {qeSetQuantifier = All})+>     ,("select distinct a from t",qe {qeSetQuantifier = Distinct})+>     ,("select * from t", qe {qeSelectList = [(Star,Nothing)]})+>     ,("select a.* from t"+>      ,qe {qeSelectList = [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "."] Star+>                            ,Nothing)]})+>     ,("select a b from t"+>      ,qe {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]})+>     ,("select a as b from t"+>      ,qe {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "b")]})+>     ,("select a,b from t"+>      ,qe {qeSelectList = [(Iden [Name Nothing "a"], Nothing)+>                          ,(Iden [Name Nothing "b"], Nothing)]})+>     -- todo: all field reference alias+>     --,("select * as (a,b) from t",undefined)+>     ]+>   where+>     qe = makeSelect+>          {qeSelectList = [(Iden [Name Nothing "a"], Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }++== 7.13 <query expression>++Function+Specify a table.++<query expression> ::=+  [ <with clause> ] <query expression body>+      [ <order by clause> ] [ <result offset clause> ] [ <fetch first clause> ]++<with clause> ::= WITH [ RECURSIVE ] <with list>++<with list> ::= <with list element> [ { <comma> <with list element> }... ]++<with list element> ::=+  <query name> [ <left paren> <with column list> <right paren> ]+      AS <table subquery> [ <search or cycle clause> ]++<with column list> ::= <column name list>++> withQueryExpression :: TestItem+> withQueryExpression= Group "with query expression"+>     [-- todo: with query expression+>     ]++<query expression body> ::=+    <query term>+  | <query expression body> UNION [ ALL | DISTINCT ]+      [ <corresponding spec> ] <query term>+  | <query expression body> EXCEPT [ ALL | DISTINCT ]+      [ <corresponding spec> ] <query term>++<query term> ::=+    <query primary>+  | <query term> INTERSECT [ ALL | DISTINCT ]+      [ <corresponding spec> ] <query primary>++<query primary> ::=+    <simple table>+  | <left paren> <query expression body>+      [ <order by clause> ] [ <result offset clause> ] [ <fetch first clause> ]+      <right paren>++> setOpQueryExpression :: TestItem+> setOpQueryExpression= Group "set operation query expression"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     -- todo: complete setop query expression tests+>     [{-("select * from t union select * from t"+>      ,undefined)+>     ,("select * from t union all select * from t"+>      ,undefined)+>     ,("select * from t union distinct select * from t"+>      ,undefined)+>     ,("select * from t union corresponding select * from t"+>      ,undefined)+>     ,("select * from t union corresponding by (a,b) select * from t"+>      ,undefined)+>     ,("select * from t except select * from t"+>      ,undefined)+>     ,("select * from t in intersect select * from t"+>      ,undefined)-}+>     ]++TODO: tests for the associativity and precendence++TODO: not sure exactly where parens are allowed, we will allow them+everywhere++<simple table> ::=+    <query specification>+  | <table value constructor>+  | <explicit table>++<explicit table> ::= TABLE <table or query name>++<corresponding spec> ::=+  CORRESPONDING [ BY <left paren> <corresponding column list> <right paren> ]++<corresponding column list> ::= <column name list>++> explicitTableQueryExpression :: TestItem+> explicitTableQueryExpression= Group "explicit table query expression"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("table t", Table [Name Nothing "t"])+>     ]+++<order by clause> ::= ORDER BY <sort specification list>++<result offset clause> ::= OFFSET <offset row count> { ROW | ROWS }++<fetch first clause> ::=+  FETCH { FIRST | NEXT } [ <fetch first quantity> ] { ROW | ROWS } { ONLY | WITH TIES }++<fetch first quantity> ::= <fetch first row count> | <fetch first percentage>++<offset row count> ::= <simple value specification>++<fetch first row count> ::= <simple value specification>++<fetch first percentage> ::= <simple value specification> PERCENT++> orderOffsetFetchQueryExpression :: TestItem+> orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [-- todo: finish tests for order offset and fetch+>      ("select a from t order by a"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])+>                            DirDefault NullsOrderDefault]})+>     ,("select a from t offset 5 row"+>      ,qe {qeOffset = Just $ NumLit "5"})+>     ,("select a from t offset 5 rows"+>      ,qe {qeOffset = Just $ NumLit "5"})+>     ,("select a from t fetch first 5 row only"+>      ,qe {qeFetchFirst = Just $ NumLit "5"})+>     -- todo: support with ties and percent in fetch+>     --,("select a from t fetch next 5 rows with ties"+>     --,("select a from t fetch first 5 percent rows only"+>     ]+>  where+>     qe = makeSelect+>          {qeSelectList = [(Iden [Name Nothing "a"], Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }+++== 7.14 <search or cycle clause>++Function++Specify the generation of ordering and cycle detection information in+the result of recursive query expressions.++<search or cycle clause> ::=+    <search clause>+  | <cycle clause>+  | <search clause> <cycle clause>++<search clause> ::= SEARCH <recursive search order> SET <sequence column>++<recursive search order> ::=+    DEPTH FIRST BY <column name list>+  | BREADTH FIRST BY <column name list>++<sequence column> ::= <column name>++<cycle clause> ::=+  CYCLE <cycle column list> SET <cycle mark column> TO <cycle mark value>+      DEFAULT <non-cycle mark value> USING <path column>++<cycle column list> ::= <cycle column> [ { <comma> <cycle column> }... ]++<cycle column> ::= <column name>++<cycle mark column> ::= <column name>++<path column> ::= <column name>++<cycle mark value> ::= <value expression>++<non-cycle mark value> ::= <value expression>++> searchOrCycleClause :: TestItem+> searchOrCycleClause = Group "search or cycle clause"+>     [-- todo: search or cycle clause+>     ]++== 7.15 <subquery>++Function++Specify a scalar value, a row, or a table derived from a <query+expression>.++<scalar subquery> ::= <subquery>++<row subquery> ::= <subquery>++<table subquery> ::= <subquery>++<subquery> ::= <left paren> <query expression> <right paren>++> scalarSubquery :: TestItem+> scalarSubquery = Group "scalar subquery"+>     [-- todo: scalar subquery+>     ]++= 8 Predicates++== 8.1 <predicate>++Function+Specify a condition that can be evaluated to give a boolean value.++<predicate> ::=+    <comparison predicate>+  | <between predicate>+  | <in predicate>+  | <like predicate>+  | <similar predicate>+  | <regex like predicate>+  | <null predicate>+  | <quantified comparison predicate>+  | <exists predicate>+  | <unique predicate>+  | <normalized predicate>+  | <match predicate>+  | <overlaps predicate>+  | <distinct predicate>+  | <member predicate>+  | <submultiset predicate>+  | <set predicate>+  | <type predicate>+  | <period predicate>++> predicates :: TestItem+> predicates = Group "predicates"+>     [comparisonPredicates+>     ,betweenPredicate+>     ,inPredicate+>     ,likePredicate+>     ,similarPredicate+>     ,regexLikePredicate+>     ,nullPredicate+>     ,quantifiedComparisonPredicate+>     ,existsPredicate+>     ,uniquePredicate+>     ,normalizedPredicate+>     ,matchPredicate+>     ,overlapsPredicate+>     ,distinctPredicate+>     ,memberPredicate+>     ,submultisetPredicate+>     ,setPredicate+>     ,periodPredicate+>     ]+++== 8.1 <predicate>++No grammar++== 8.2 <comparison predicate>++Function+Specify a comparison of two row values.++<comparison predicate> ::= <row value predicand> <comparison predicate part 2>++<comparison predicate part 2> ::= <comp op> <row value predicand>++<comp op> ::=+    <equals operator>+  | <not equals operator>+  | <less than operator>+  | <greater than operator>+  | <less than or equals operator>+  | <greater than or equals operator>++> comparisonPredicates :: TestItem+> comparisonPredicates = Group "comparison predicates"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     $ map mkOp ["=", "<>", "<", ">", "<=", ">="]+>     ++ [("ROW(a) = ROW(b)"+>         ,BinOp (App [Name Nothing "ROW"] [a])+>                [Name Nothing "="]+>                (App [Name Nothing "ROW"] [b]))+>        ,("(a,b) = (c,d)"+>         ,BinOp (SpecialOp [Name Nothing "rowctor"] [a,b])+>            [Name Nothing "="]+>            (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "c"], Iden [Name Nothing "d"]]))+>     ]+>   where+>     mkOp nm = ("a " ++ nm ++ " b"+>               ,BinOp a [Name Nothing nm] b)+>     a = Iden [Name Nothing "a"]+>     b = Iden [Name Nothing "b"]++TODO: what other tests, more complex expressions with comparisons?++== 8.3 <between predicate>++Function+Specify a range comparison.++<between predicate> ::= <row value predicand> <between predicate part 2>++<between predicate part 2> ::=+  [ NOT ] BETWEEN [ ASYMMETRIC | SYMMETRIC ]+      <row value predicand> AND <row value predicand>++> betweenPredicate :: TestItem+> betweenPredicate = Group "between predicate"+>     [-- todo: between predicate+>     ]++== 8.4 <in predicate>++Function+Specify a quantified comparison.++<in predicate> ::= <row value predicand> <in predicate part 2>++<in predicate part 2> ::= [ NOT ] IN <in predicate value>++<in predicate value> ::=+    <table subquery>+  | <left paren> <in value list> <right paren>++<in value list> ::=+  <row value expression> [ { <comma> <row value expression> }... ]++> inPredicate :: TestItem+> inPredicate = Group "in predicate"+>     [-- todo: in predicate+>     ]++== 8.5 <like predicate>++Function+Specify a pattern-match comparison.++<like predicate> ::= <character like predicate> | <octet like predicate>++<character like predicate> ::=+  <row value predicand> <character like predicate part 2>++<character like predicate part 2> ::=+  [ NOT ] LIKE <character pattern> [ ESCAPE <escape character> ]++<character pattern> ::= <character value expression>++<escape character> ::= <character value expression>++<octet like predicate> ::= <row value predicand> <octet like predicate part 2>++<octet like predicate part 2> ::=+  [ NOT ] LIKE <octet pattern> [ ESCAPE <escape octet> ]++<octet pattern> ::= <binary value expression>++<escape octet> ::= <binary value expression>++> likePredicate :: TestItem+> likePredicate = Group "like predicate"+>     [-- todo: like predicate+>     ]++== 8.6 <similar predicate>++Function+Specify a character string similarity by means of a regular expression.++<similar predicate> ::= <row value predicand> <similar predicate part 2>++<similar predicate part 2> ::=+  [ NOT ] SIMILAR TO <similar pattern> [ ESCAPE <escape character> ]++<similar pattern> ::= <character value expression>++<regular expression> ::=+    <regular term>+  | <regular expression> <vertical bar> <regular term>++<regular term> ::= <regular factor> | <regular term> <regular factor>++<regular factor> ::=+    <regular primary>+  | <regular primary> <asterisk>+  | <regular primary> <plus sign>+  | <regular primary> <question mark>+  | <regular primary> <repeat factor>++<repeat factor> ::= <left brace> <low value> [ <upper limit> ] <right brace>++<upper limit> ::= <comma> [ <high value> ]++<low value> ::= <unsigned integer>++<high value> ::= <unsigned integer>++<regular primary> ::=+    <character specifier>+  | <percent>+  | <regular character set>+  | <left paren> <regular expression> <right paren>++<character specifier> ::= <non-escaped character> | <escaped character>++<non-escaped character> ::= !! See the Syntax Rules.++<escaped character> ::= !! See the Syntax Rules.++<regular character set> ::=+    <underscore>+  | <left bracket> <character enumeration>... <right bracket>+  | <left bracket> <circumflex> <character enumeration>... <right bracket>+  | <left bracket> <character enumeration include>...+      <circumflex> <character enumeration exclude>... <right bracket>++<character enumeration include> ::= <character enumeration>++<character enumeration exclude> ::= <character enumeration>++<character enumeration> ::=+    <character specifier>+  | <character specifier> <minus sign> <character specifier>+  | <left bracket> <colon> <regular character set identifier> <colon> <right bracket>++<regular character set identifier> ::= <identifier>++> similarPredicate :: TestItem+> similarPredicate = Group "similar predicate"+>     [-- todo: similar predicate+>     ]+++== 8.7 <regex like predicate>++Function+Specify a pattern-match comparison using an XQuery regular expression.++<regex like predicate> ::= <row value predicand> <regex like predicate part 2>++<regex like predicate part 2> ::=+  [ NOT ] LIKE_REGEX <XQuery pattern> [ FLAG <XQuery option flag> ]++> regexLikePredicate :: TestItem+> regexLikePredicate = Group "regex like predicate"+>     [-- todo: regex like predicate+>     ]++== 8.8 <null predicate>++Function+Specify a test for a null value.++<null predicate> ::= <row value predicand> <null predicate part 2>++<null predicate part 2> ::= IS [ NOT ] NULL++> nullPredicate :: TestItem+> nullPredicate = Group "null predicate"+>     [-- todo: null predicate+>     ]++== 8.9 <quantified comparison predicate>++Function+Specify a quantified comparison.++<quantified comparison predicate> ::=+  <row value predicand> <quantified comparison predicate part 2>++<quantified comparison predicate part 2> ::=+  <comp op> <quantifier> <table subquery>++<quantifier> ::= <all> | <some>++<all> ::= ALL++<some> ::= SOME | ANY++> quantifiedComparisonPredicate :: TestItem+> quantifiedComparisonPredicate = Group "quantified comparison predicate"+>     $ map (uncurry (TestScalarExpr ansi2011))++>     [("a = any (select * from t)"+>      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPAny qe)+>     ,("a <= some (select * from t)"+>      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPSome qe)+>     ,("a > all (select * from t)"+>      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll qe)+>     ,("(a,b) <> all (select * from t)"+>      ,QuantifiedComparison+>       (SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"]+>                                   ,Iden [Name Nothing "b"]]) [Name Nothing "<>"] CPAll qe)+>     ]+>   where+>     qe = makeSelect+>          {qeSelectList = [(Star,Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]}++== 8.10 <exists predicate>++Function+Specify a test for a non-empty set.++<exists predicate> ::= EXISTS <table subquery>++> existsPredicate :: TestItem+> existsPredicate = Group "exists predicate"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("exists(select * from t where a = 4)"+>      ,SubQueryExpr SqExists+>       $ makeSelect+>         {qeSelectList = [(Star,Nothing)]+>         ,qeFrom = [TRSimple [Name Nothing "t"]]+>         ,qeWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4"))+>         }+>      )]++== 8.11 <unique predicate>++Function+Specify a test for the absence of duplicate rows.++<unique predicate> ::= UNIQUE <table subquery>++> uniquePredicate :: TestItem+> uniquePredicate = Group "unique predicate"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("unique(select * from t where a = 4)"+>      ,SubQueryExpr SqUnique+>       $ makeSelect+>         {qeSelectList = [(Star,Nothing)]+>         ,qeFrom = [TRSimple [Name Nothing "t"]]+>         ,qeWhere = Just (BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "4"))+>         }+>      )]++== 8.12 <normalized predicate>++Function+Determine whether a character string value is normalized.++<normalized predicate> ::= <row value predicand> <normalized predicate part 2>++<normalized predicate part 2> ::= IS [ NOT ] [ <normal form> ] NORMALIZED++> normalizedPredicate :: TestItem+> normalizedPredicate = Group "normalized predicate"+>     [-- todo: normalized predicate+>     ]++== 8.13 <match predicate>++Function+Specify a test for matching rows.++<match predicate> ::= <row value predicand> <match predicate part 2>++<match predicate part 2> ::=+  MATCH [ UNIQUE ] [ SIMPLE | PARTIAL | FULL ] <table subquery>++> matchPredicate :: TestItem+> matchPredicate = Group "match predicate"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("a match (select a from t)"+>      ,Match (Iden [Name Nothing "a"]) False qe)+>     ,("(a,b) match (select a,b from t)"+>      ,Match (SpecialOp [Name Nothing "rowctor"]+>              [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) False qea)+>     ,("(a,b) match unique (select a,b from t)"+>      ,Match (SpecialOp [Name Nothing "rowctor"]+>              [Iden [Name Nothing "a"], Iden [Name Nothing "b"]]) True qea)+>     ]+>   where+>     qe = makeSelect+>          {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]}+>     qea = qe {qeSelectList = qeSelectList qe+>                              ++ [(Iden [Name Nothing "b"],Nothing)]}++TODO: simple, partial and full++== 8.14 <overlaps predicate>++Function+Specify a test for an overlap between two datetime periods.++<overlaps predicate> ::=+  <overlaps predicate part 1> <overlaps predicate part 2>++<overlaps predicate part 1> ::= <row value predicand 1>++<overlaps predicate part 2> ::= OVERLAPS <row value predicand 2>++<row value predicand 1> ::= <row value predicand>++<row value predicand 2> ::= <row value predicand>++> overlapsPredicate :: TestItem+> overlapsPredicate = Group "overlaps predicate"+>     [-- todo: overlaps predicate+>     ]++== 8.15 <distinct predicate>++Function+Specify a test of whether two row values are distinct++<distinct predicate> ::= <row value predicand 3> <distinct predicate part 2>++<distinct predicate part 2> ::=+  IS [ NOT ] DISTINCT FROM <row value predicand 4>++<row value predicand 3> ::= <row value predicand>++<row value predicand 4> ::= <row value predicand>++> distinctPredicate :: TestItem+> distinctPredicate = Group "distinct predicate"+>     [-- todo: distinct predicate+>     ]++== 8.16 <member predicate>++Function+Specify a test of whether a value is a member of a multiset.++<member predicate> ::= <row value predicand> <member predicate part 2>++<member predicate part 2> ::= [ NOT ] MEMBER [ OF ] <multiset value expression>++> memberPredicate :: TestItem+> memberPredicate = Group "member predicate"+>     [-- todo: member predicate+>     ]++== 8.17 <submultiset predicate>++Function+Specify a test of whether a multiset is a submultiset of another multiset.++<submultiset predicate> ::=+  <row value predicand> <submultiset predicate part 2>++<submultiset predicate part 2> ::=+  [ NOT ] SUBMULTISET [ OF ] <multiset value expression>++> submultisetPredicate :: TestItem+> submultisetPredicate = Group "submultiset predicate"+>     [-- todo: submultiset predicate+>     ]++== 8.18 <set predicate>++Function++Specify a test of whether a multiset is a set (that is, does not+contain any duplicates).++<set predicate> ::= <row value predicand> <set predicate part 2>++<set predicate part 2> ::= IS [ NOT ] A SET++> setPredicate :: TestItem+> setPredicate = Group "set predicate"+>     [-- todo: set predicate+>     ]++== 8.19 <type predicate>++Function+Specify a type test.++<type predicate> ::= <row value predicand> <type predicate part 2>++<type predicate part 2> ::=+  IS [ NOT ] OF <left paren> <type list> <right paren>++<type list> ::=+  <user-defined type specification>+      [ { <comma> <user-defined type specification> }... ]++<user-defined type specification> ::=+    <inclusive user-defined type specification>+  | <exclusive user-defined type specification>++<inclusive user-defined type specification> ::=+  <path-resolved user-defined type name>++<exclusive user-defined type specification> ::=+  ONLY <path-resolved user-defined type name>++TODO: type predicate++== 8.20 <period predicate>++Function+Specify a test to determine the relationship between periods.++<period predicate> ::=+    <period overlaps predicate>+  | <period equals predicate>+  | <period contains predicate>+  | <period precedes predicate>+  | <period succeeds predicate>+  | <period immediately precedes predicate>+  | <period immediately succeeds predicate>++<period overlaps predicate> ::=+  <period predicand 1> <period overlaps predicate part 2>++<period overlaps predicate part 2> ::= OVERLAPS <period predicand 2>++<period predicand 1> ::= <period predicand>++<period predicand 2> ::= <period predicand>++<period predicand> ::=+    <period reference>+  | PERIOD <left paren> <period start value> <comma> <period end value> <right paren>++<period reference> ::= <basic identifier chain>++<period start value> ::= <datetime value expression>++<period end value> ::= <datetime value expression>++<period equals predicate> ::=+  <period predicand 1> <period equals predicate part 2>++<period equals predicate part 2> ::= EQUALS <period predicand 2>++<period contains predicate> ::=+  <period predicand 1> <period contains predicate part 2>++<period contains predicate part 2> ::=+  CONTAINS <period or point-in-time predicand>++<period or point-in-time predicand> ::=+    <period predicand>+  | <datetime value expression>++<period precedes predicate> ::=+  <period predicand 1> <period precedes predicate part 2>++<period precedes predicate part 2> ::= PRECEDES <period predicand 2>++<period succeeds predicate> ::=+  <period predicand 1> <period succeeds predicate part 2>++<period succeeds predicate part 2> ::= SUCCEEDS <period predicand 2>++<period immediately precedes predicate> ::=+  <period predicand 1> <period immediately precedes predicate part 2>++<period immediately precedes predicate part 2> ::=+  IMMEDIATELY PRECEDES <period predicand 2>++<period immediately succeeds predicate> ::=+  <period predicand 1> <period immediately succeeds predicate part 2>++<period immediately succeeds predicate part 2> ::=+  IMMEDIATELY SUCCEEDS <period predicand 2>++> periodPredicate :: TestItem+> periodPredicate = Group "period predicate"+>     [-- todo: period predicate+>     ]++== 8.21 <search condition>++Function++Specify a condition that is True, False, or Unknown, depending on the+value of a <boolean value expression>.++<search condition> ::= <boolean value expression>++= 10 Additional common elements++== 10.1 <interval qualifier>++Function+Specify the precision of an interval data type.++<interval qualifier> ::= <start field> TO <end field> | <single datetime field>++<start field> ::=+  <non-second primary datetime field>+      [ <left paren> <interval leading field precision> <right paren> ]++<end field> ::=+    <non-second primary datetime field>+  | SECOND [ <left paren> <interval fractional seconds precision> <right paren> ]++<single datetime field> ::=+    <non-second primary datetime field>+        [ <left paren> <interval leading field precision> <right paren> ]+  | SECOND [ <left paren> <interval leading field precision>+      [ <comma> <interval fractional seconds precision> ] <right paren> ]++<primary datetime field> ::= <non-second primary datetime field> | SECOND++<non-second primary datetime field> ::= YEAR | MONTH | DAY | HOUR | MINUTE++<interval fractional seconds precision> ::= <unsigned integer>++<interval leading field precision> ::= <unsigned integer>++> intervalQualifier :: TestItem+> intervalQualifier = Group "interval qualifier"+>     [-- todo: interval qualifier+>     ]++todo: also test all of these in the typenames and in the interval+literal tests++== 10.2 <language clause>++Function+Specify a programming language.++<language clause> ::= LANGUAGE <language name>++<language name> ::= ADA | C | COBOL | FORTRAN | M | MUMPS | PASCAL | PLI | SQL++== 10.3 <path specification>++Function+Specify an order for searching for an SQL-invoked routine.++<path specification> ::= PATH <schema name list>++<schema name list> ::= <schema name> [ { <comma> <schema name> }... ]++== 10.4 <routine invocation>++Function+Invoke an SQL-invoked routine.++<routine invocation> ::= <routine name> <SQL argument list>++<routine name> ::= [ <schema name> <period> ] <qualified identifier>++<SQL argument list> ::=+  <left paren> [ <SQL argument> [ { <comma> <SQL argument> }... ] ] <right paren>++<SQL argument> ::=+    <value expression>+  | <generalized expression>+  | <target specification>+  | <contextually typed value specification>+  | <named argument specification>++<generalized expression> ::=+  <value expression> AS <path-resolved user-defined type name>++<named argument specification> ::=+  <SQL parameter name> <named argument assignment token>+      <named argument SQL argument>++<named argument SQL argument> ::=+    <value expression>+  | <target specification>+     | <contextually typed value specification>++== 10.5 <character set specification>++Function+Identify a character set.++<character set specification> ::=+    <standard character set name>+  | <implementation-defined character set name>+  | <user-defined character set name>++<standard character set name> ::= <character set name>++<implementation-defined character set name> ::= <character set name>++<user-defined character set name> ::= <character set name>++tested in the type names++== 10.6 <specific routine designator>++Function+Specify an SQL-invoked routine.++<specific routine designator> ::=+    SPECIFIC <routine type> <specific name>+  | <routine type> <member name> [ FOR <schema-resolved user-defined type name> ]++<routine type> ::=+    ROUTINE+  | FUNCTION+  | PROCEDURE+  | [ INSTANCE | STATIC | CONSTRUCTOR ] METHOD++<member name> ::= <member name alternatives> [ <data type list> ]++<member name alternatives> ::= <schema qualified routine name> | <method name>++<data type list> ::=+  <left paren> [ <data type> [ { <comma> <data type> }... ] ] <right paren>++== 10.7 <collate clause>++Function+Specify a default collation.++<collate clause> ::= COLLATE <collation name>++> collateClause :: TestItem+> collateClause = Group "collate clause"+>     $ map (uncurry (TestScalarExpr ansi2011))+>     [("a collate my_collation"+>      ,Collate (Iden [Name Nothing "a"]) [Name Nothing "my_collation"])]++== 10.8 <constraint name definition> and <constraint characteristics>++Function+Specify the name of a constraint and its characteristics.++<constraint name definition> ::= CONSTRAINT <constraint name>++<constraint characteristics> ::=+    <constraint check time> [ [ NOT ] DEFERRABLE ] [ <constraint enforcement> ]+  | [ NOT ] DEFERRABLE [ <constraint check time> ] [ <constraint enforcement> ]+  | <constraint enforcement>++<constraint check time> ::= INITIALLY DEFERRED | INITIALLY IMMEDIATE++<constraint enforcement> ::= [ NOT ] ENFORCED++== 10.9 <aggregate function>++Function+Specify a value computed from a collection of rows.++<aggregate function> ::=+    COUNT <left paren> <asterisk> <right paren> [ <filter clause> ]+  | <general set function> [ <filter clause> ]+  | <binary set function> [ <filter clause> ]+  | <ordered set function> [ <filter clause> ]+  | <array aggregate function> [ <filter clause> ]++<general set function> ::=+  <set function type> <left paren> [ <set quantifier> ]+      <value expression> <right paren>++<set function type> ::= <computational operation>++<computational operation> ::=+    AVG+  | MAX+  | MIN+  | SUM+  | EVERY+  | ANY+  | SOME+  | COUNT+  | STDDEV_POP+  | STDDEV_SAMP+  | VAR_SAMP+  | VAR_POP+  | COLLECT+  | FUSION+  | INTERSECTION++<set quantifier> ::= DISTINCT | ALL++<filter clause> ::= FILTER <left paren> WHERE <search condition> <right paren>++<binary set function> ::=+  <binary set function type> <left paren> <dependent variable expression> <comma>+      <independent variable expression> <right paren>++<binary set function type> ::=+    COVAR_POP+  | COVAR_SAMP+  | CORR+  | REGR_SLOPE+  | REGR_INTERCEPT+  | REGR_COUNT+  | REGR_R2+  | REGR_AVGX+  | REGR_AVGY+  | REGR_SXX+  | REGR_SYY+  | REGR_SXY++<dependent variable expression> ::= <numeric value expression>++<independent variable expression> ::= <numeric value expression>++<ordered set function> ::=+    <hypothetical set function>+  | <inverse distribution function>++<hypothetical set function> ::=+  <rank function type> <left paren>+      <hypothetical set function value expression list> <right paren>+      <within group specification>++<within group specification> ::=+  WITHIN GROUP <left paren> ORDER BY <sort specification list> <right paren>++<hypothetical set function value expression list> ::=+  <value expression> [ { <comma> <value expression> }... ]++<inverse distribution function> ::=+  <inverse distribution function type> <left paren>+      <inverse distribution function argument> <right paren>+      <within group specification>++<inverse distribution function argument> ::= <numeric value expression>++<inverse distribution function type> ::= PERCENTILE_CONT | PERCENTILE_DISC++<array aggregate function> ::=+  ARRAY_AGG+      <left paren> <value expression> [ ORDER BY <sort specification list> ] <right paren>++> aggregateFunction :: TestItem+> aggregateFunction = Group "aggregate function"+>     $ map (uncurry (TestScalarExpr ansi2011)) $+>     [("count(*)",App [Name Nothing "count"] [Star])+>     ,("count(*) filter (where something > 5)"+>      ,AggregateApp [Name Nothing "count"] SQDefault [Star] [] fil)++gsf++>     ,("count(a)",App [Name Nothing "count"] [Iden [Name Nothing "a"]])+>     ,("count(distinct a)"+>      ,AggregateApp [Name Nothing "count"]+>                    Distinct+>                    [Iden [Name Nothing "a"]] [] Nothing)+>     ,("count(all a)"+>      ,AggregateApp [Name Nothing "count"]+>                    All+>                    [Iden [Name Nothing "a"]] [] Nothing)+>     ,("count(all a) filter (where something > 5)"+>      ,AggregateApp [Name Nothing "count"]+>                    All+>                    [Iden [Name Nothing "a"]] [] fil)+>     ] ++ concatMap mkSimpleAgg+>          ["avg","max","min","sum"+>          ,"every", "any", "some"+>          ,"stddev_pop","stddev_samp","var_samp","var_pop"+>          ,"collect","fusion","intersection"]++bsf++>     ++ concatMap mkBsf+>          ["COVAR_POP","COVAR_SAMP","CORR","REGR_SLOPE"+>           ,"REGR_INTERCEPT","REGR_COUNT","REGR_R2"+>           ,"REGR_AVGX","REGR_AVGY"+>           ,"REGR_SXX","REGR_SYY","REGR_SXY"]++osf++>     +++>     [("rank(a,c) within group (order by b)"+>      ,AggregateAppGroup [Name Nothing "rank"]+>           [Iden [Name Nothing "a"], Iden [Name Nothing "c"]]+>           ob)]+>     ++ map mkGp ["dense_rank","percent_rank"+>                 ,"cume_dist", "percentile_cont"+>                 ,"percentile_disc"]+>     ++ [("array_agg(a)", App [Name Nothing "array_agg"] [Iden [Name Nothing "a"]])+>        ,("array_agg(a order by z)"+>         ,AggregateApp [Name Nothing "array_agg"]+>                        SQDefault+>                        [Iden [Name Nothing "a"]]+>                        [SortSpec (Iden [Name Nothing "z"])+>                             DirDefault NullsOrderDefault]+>                        Nothing)]++>   where+>     fil = Just $ BinOp (Iden [Name Nothing "something"]) [Name Nothing ">"] (NumLit "5")+>     ob = [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault]+>     mkGp nm = (nm ++ "(a) within group (order by b)"+>               ,AggregateAppGroup [Name Nothing nm]+>                [Iden [Name Nothing "a"]]+>                ob)++>     mkSimpleAgg nm =+>         [(nm ++ "(a)",App [Name Nothing nm] [Iden [Name Nothing "a"]])+>         ,(nm ++ "(distinct a)"+>          ,AggregateApp [Name Nothing nm]+>                        Distinct+>                        [Iden [Name Nothing "a"]] [] Nothing)]+>     mkBsf nm =+>         [(nm ++ "(a,b)",App [Name Nothing nm] [Iden [Name Nothing "a"],Iden [Name Nothing "b"]])+>         ,(nm ++"(a,b) filter (where something > 5)"+>           ,AggregateApp [Name Nothing nm]+>                         SQDefault+>                         [Iden [Name Nothing "a"],Iden [Name Nothing "b"]] [] fil)]++== 10.10 <sort specification list>++Function+Specify a sort order.++<sort specification list> ::=+  <sort specification> [ { <comma> <sort specification> }... ]++<sort specification> ::=+  <sort key> [ <ordering specification> ] [ <null ordering> ]++<sort key> ::= <value expression>++<ordering specification> ::= ASC | DESC++<null ordering> ::=+  | NULLS LAST+    NULLS FIRST++> sortSpecificationList :: TestItem+> sortSpecificationList = Group "sort specification list"+>     $ map (uncurry (TestQueryExpr ansi2011))+>     [("select * from t order by a"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a,b"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])+>                            DirDefault NullsOrderDefault+>                       ,SortSpec (Iden [Name Nothing "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a asc,b"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])+>                            Asc NullsOrderDefault+>                       ,SortSpec (Iden [Name Nothing "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a desc,b"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name Nothing "a"])+>                            Desc NullsOrderDefault+>                       ,SortSpec (Iden [Name Nothing "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a collate x desc,b"+>      ,qe {qeOrderBy = [SortSpec+>                            (Collate (Iden [Name Nothing "a"]) [Name Nothing "x"])+>                            Desc NullsOrderDefault+>                       ,SortSpec (Iden [Name Nothing "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by 1,2"+>      ,qe {qeOrderBy = [SortSpec (NumLit "1")+>                            DirDefault NullsOrderDefault+>                       ,SortSpec (NumLit "2")+>                            DirDefault NullsOrderDefault]})+>     ]+>   where+>     qe = makeSelect+>          {qeSelectList = [(Star,Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]}
+ tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs view
@@ -0,0 +1,2057 @@++Section 11 in Foundation++This module covers the tests for parsing schema and DDL statements.++> module Language.SQL.SimpleSQL.SQL2011Schema (sql2011SchemaTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> sql2011SchemaTests :: TestItem+> sql2011SchemaTests = Group "sql 2011 schema tests"+>     [+++11.1 <schema definition>++<schema definition> ::=+  CREATE SCHEMA <schema name clause>+      [ <schema character set or path> ]+      [ <schema element>... ]++>      (TestStatement ansi2011 "create schema my_schema"+>      $ CreateSchema [Name Nothing "my_schema"])++todo: schema name can have .+schema name can be quoted iden or unicode quoted iden+add schema element support:+  create a list of schema elements+  then do pairwise combinations in schema element list to test+++<schema character set or path> ::=+    <schema character set specification>+  | <schema path specification>+  | <schema character set specification> <schema path specification>+  | <schema path specification> <schema character set specification>++<schema name clause> ::=+    <schema name>+  | AUTHORIZATION <schema authorization identifier>+  | <schema name> AUTHORIZATION <schema authorization identifier>++<schema authorization identifier> ::=+  <authorization identifier>++<schema character set specification> ::=+  DEFAULT CHARACTER SET <character set specification>++<schema path specification> ::=+  <path specification>++<schema element> ::=+      <table definition>+  |   <view definition>+  |   <domain definition>+  |   <character set definition>+  |   <collation definition>+  |   <transliteration definition>+  |   <assertion definition>+  |   <trigger definition>+  |   <user-defined type definition>+  |   <user-defined cast definition>+  |   <user-defined ordering definition>+  |   <transform definition>+  |   <schema routine>+  |   <sequence generator definition>+  |   <grant statement>+  |   <role definition>+++11.2 <drop schema statement>++<drop schema statement> ::=+  DROP SCHEMA <schema name> <drop behavior>++<drop behavior> ::=+    CASCADE+  | RESTRICT+++>     ,(TestStatement ansi2011 "drop schema my_schema"+>      $ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour)+>     ,(TestStatement ansi2011 "drop schema my_schema cascade"+>      $ DropSchema [Name Nothing "my_schema"] Cascade)+>     ,(TestStatement ansi2011 "drop schema my_schema restrict"+>      $ DropSchema [Name Nothing "my_schema"] Restrict)++11.3 <table definition>+++<table definition> ::=+  CREATE [ <table scope> ] TABLE <table name> <table contents source>+      [ WITH <system versioning clause> ]+      [ ON COMMIT <table commit action> ROWS ]++>     ,(TestStatement ansi2011 "create table t (a int, b int);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []])+++<table contents source> ::=+    <table element list>+  | <typed table clause>+  | <as subquery clause>++<table scope> ::=+  <global or local> TEMPORARY++<global or local> ::=+    GLOBAL+  | LOCAL++<system versioning clause> ::=+  SYSTEM VERSIONING++defintely skip++<table commit action> ::=+    PRESERVE+  | DELETE++defintely skip++<table element list> ::=+  <left paren> <table element> [ { <comma> <table element> }... ] <right paren>++<table element> ::=+    <column definition>+  | <table period definition>+  | <table constraint definition>+  | <like clause>++<typed table clause> ::=+  OF <path-resolved user-defined type name> [ <subtable clause> ]+      [ <typed table element list> ]++defintely skip++<typed table element list> ::=+  <left paren> <typed table element>+      [ { <comma> <typed table element> }... ] <right paren>++defintely skip++<typed table element> ::=+    <column options>+ | <table constraint definition>+  | <self-referencing column specification>++defintely skip++<self-referencing column specification> ::=+  REF IS <self-referencing column name> [ <reference generation> ]++defintely skip++<reference generation> ::=+    SYSTEM GENERATED+  | USER GENERATED+  | DERIVED++defintely skip++<self-referencing column name> ::=+  <column name>++defintely skip++<column options> ::=+  <column name> WITH OPTIONS <column option list>++defintely skip++<column option list> ::=+  [ <scope clause> ] [ <default clause> ] [ <column constraint definition>... ]++defintely skip++<subtable clause> ::=+  UNDER <supertable clause>++defintely skip++<supertable clause> ::=+  <supertable name>++defintely skip++<supertable name> ::=+  <table name>++defintely skip++<like clause> ::=+  LIKE <table name> [ <like options> ]++<like options> ::=+  <like option>...++<like option> ::=+    <identity option>+  | <column default option>+  | <generation option>++<identity option> ::=+    INCLUDING IDENTITY+  | EXCLUDING IDENTITY++<column default option> ::=+    INCLUDING DEFAULTS+  | EXCLUDING DEFAULTS++<generation option> ::=+    INCLUDING GENERATED+  | EXCLUDING GENERATED++<as subquery clause> ::=+  [ <left paren> <column name list> <right paren> ] AS <table subquery>+      <with or without data>++<with or without data> ::=+    WITH NO DATA+  | WITH DATA++<table period definition> ::=+  <system or application time period specification>+      <left paren> <period begin column name> <comma> <period end column name> <right paren>++defintely skip++<system or application time period specification> ::=+    <system time period specification>+  | <application time period specification>++defintely skip++<system time period specification> ::=+  PERIOD FOR SYSTEM_TIME++defintely skip++<application time period specification> ::=+  PERIOD FOR <application time period name>++defintely skip++<application time period name> ::=+  <identifier>++defintely skip++<period begin column name> ::=+  <column name>++defintely skip++<period end column name> ::=+  <column name>++defintely skip+++11.4 <column definition>++<column definition> ::=+  <column name> [ <data type or domain name> ]+      [ <default clause> | <identity column specification> | <generation clause>+      | <system time period start column specification>+      | <system time period end column specification> ]+      [ <column constraint definition>... ]+      [ <collate clause> ]++<data type or domain name> ::=+    <data type>+  | <domain name>++<system time period start column specification> ::=+  <timestamp generation rule> AS ROW START++defintely skip++<system time period end column specification> ::=+  <timestamp generation rule> AS ROW END++defintely skip++<timestamp generation rule> ::=+  GENERATED ALWAYS++defintely skip++<column constraint definition> ::=+  [ <constraint name definition> ] <column constraint> [ <constraint characteristics> ]++<column constraint> ::=+    NOT NULL+  | <unique specification>+  | <references specification>+  | <check constraint definition>+++can have more than one+whitespace separated++one constratint:+optional name: constraint [Name]+not null | unique | references | check+todo: constraint characteristics+++>     ,(TestStatement ansi2011+>       "create table t (a int not null);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing ColNotNullConstraint]])++>     ,(TestStatement ansi2011+>       "create table t (a int constraint a_not_null not null);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]])++>     ,(TestStatement ansi2011+>       "create table t (a int unique);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing ColUniqueConstraint]])++>     ,(TestStatement ansi2011+>       "create table t (a int primary key);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing ColPrimaryKeyConstraint]])++references t(a,b)+  [ Full |partial| simepl]+  [perm: on update [cascade | set null | set default | restrict | no action]+         on delete ""++>     ,(TestStatement ansi2011+>       "create table t (a int references u);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          DefaultReferentialAction DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u(a));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch+>          DefaultReferentialAction DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u match full);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing MatchFull+>          DefaultReferentialAction DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u match partial);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing MatchPartial+>          DefaultReferentialAction DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u match simple);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing MatchSimple+>          DefaultReferentialAction DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u on update cascade );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          RefCascade DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u on update set null );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          RefSetNull DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u on update set default );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          RefSetDefault DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u on update no action );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          RefNoAction DefaultReferentialAction]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u on delete cascade );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          DefaultReferentialAction RefCascade]])+++>     ,(TestStatement ansi2011+>       "create table t (a int references u on update cascade on delete restrict );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          RefCascade RefRestrict]])++>     ,(TestStatement ansi2011+>       "create table t (a int references u on delete restrict on update cascade );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing $ ColReferencesConstraint+>          [Name Nothing "u"] Nothing DefaultReferenceMatch+>          RefCascade RefRestrict]])++TODO: try combinations and permutations of column constraints and+options+++>     ,(TestStatement ansi2011+>       "create table t (a int check (a>5));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing+>         [ColConstraintDef Nothing+>          (ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]])++++++<identity column specification> ::=+  GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY+      [ <left paren> <common sequence generator options> <right paren> ]++>     ,(TestStatement ansi2011 "create table t (a int generated always as identity);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+>         (Just $ IdentityColumnSpec GeneratedAlways []) []])++>     ,(TestStatement ansi2011 "create table t (a int generated by default as identity);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+>         (Just $ IdentityColumnSpec GeneratedByDefault []) []])+++>     ,(TestStatement ansi2011+>       "create table t (a int generated always as identity\n\+>       \  ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+>         (Just $ IdentityColumnSpec GeneratedAlways+>          [SGOStartWith 5+>          ,SGOIncrementBy 5+>          ,SGOMaxValue 500+>          ,SGOMinValue 5+>          ,SGOCycle]) []])++>     ,(TestStatement ansi2011+>       "create table t (a int generated always as identity\n\+>       \  ( start with -4 no maxvalue no minvalue no cycle ));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+>         (Just $ IdentityColumnSpec GeneratedAlways+>          [SGOStartWith (-4)+>          ,SGONoMaxValue+>          ,SGONoMinValue+>          ,SGONoCycle]) []])++I think <common sequence generator options> is supposed to just+whitespace separated. In db2 it seems to be csv, but the grammar here+just seems to be whitespace separated, and it is just whitespace+separated in oracle... Not completely sure though. Usually db2 is+closer than oracle?++generated always (valueexpr)++<generation clause> ::=+  <generation rule> AS <generation expression>++<generation rule> ::=+  GENERATED ALWAYS++<generation expression> ::=+  <left paren> <value expression> <right paren>++>     ,(TestStatement ansi2011+>       "create table t (a int, \n\+>       \                a2 int generated always as (a * 2));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "a2") (TypeName [Name Nothing "int"])+>         (Just $ GenerationClause+>          (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []])++++11.5 <default clause>++<default clause> ::=+  DEFAULT <default option>++<default option> ::=+    <literal>+  | <datetime value function>+  | USER+  | CURRENT_USER+  | CURRENT_ROLE+  | SESSION_USER+  | SYSTEM_USER+  | CURRENT_CATALOG+  | CURRENT_SCHEMA+  | CURRENT_PATH+  | <implicitly typed value specification>+++>     ,(TestStatement ansi2011 "create table t (a int default 0);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])+>         (Just $ DefaultClause $ NumLit "0") []])++++11.6 <table constraint definition>++<table constraint definition> ::=+  [ <constraint name definition> ] <table constraint>+      [ <constraint characteristics> ]++<table constraint> ::=+    <unique constraint definition>+  | <referential constraint definition>+  | <check constraint definition>++11.7 <unique constraint definition>++<unique constraint definition> ::=+    <unique specification> <left paren> <unique column list> [ <comma> <without overlap+    specification> ] <right paren>+  | UNIQUE ( VALUE )++<unique specification> ::=+    UNIQUE+  | PRIMARY KEY++<unique column list> ::=+  <column name list>++>     ,(TestStatement ansi2011+>       "create table t (a int, unique (a));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"]+>         ])++>     ,(TestStatement ansi2011+>       "create table t (a int, constraint a_unique unique (a));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef (Just [Name Nothing "a_unique"]) $+>             TableUniqueConstraint [Name Nothing "a"]+>         ])++todo: test permutations of column defs and table constraints++>     ,(TestStatement ansi2011+>       "create table t (a int, b int, unique (a,b));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef Nothing $+>             TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]+>         ])++>     ,(TestStatement ansi2011+>       "create table t (a int, b int, primary key (a,b));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef Nothing $+>             TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"]+>         ])+++<without overlap specification> ::=+  <application time period name> WITHOUT OVERLAPS++defintely skip+++11.8 <referential constraint definition>++<referential constraint definition> ::=+  FOREIGN KEY <left paren> <referencing column list>+      [ <comma> <referencing period specification> ] <right paren>+      <references specification>+++>     ,(TestStatement ansi2011+>       "create table t (a int, b int,\n\+>       \                foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef Nothing $+>             TableReferencesConstraint+>                 [Name Nothing "a", Name Nothing "b"]+>                 [Name Nothing "u"]+>                 (Just [Name Nothing "c", Name Nothing "d"])+>                 MatchFull RefCascade RefRestrict+>        ])++>     ,(TestStatement ansi2011+>       "create table t (a int,\n\+>       \                constraint tfku1 foreign key (a) references u);"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef (Just [Name Nothing "tfku1"]) $+>             TableReferencesConstraint+>                 [Name Nothing "a"]+>                 [Name Nothing "u"]+>                 Nothing DefaultReferenceMatch+>                 DefaultReferentialAction DefaultReferentialAction+>        ])++++<references specification> ::=+  REFERENCES <referenced table and columns>+      [ MATCH <match type> ] [ <referential triggered action> ]++<match type> ::=+    FULL+  | PARTIAL+  | SIMPLE++<referencing column list> ::=+  <column name list>++<referencing period specification> ::=+  PERIOD <application time period name>++defintely skip++<referenced table and columns> ::=+  <table name> [ <left paren> <referenced column list>+      [ <comma> <referenced period specification> ] <right paren> ]++<referenced column list> ::=+  <column name list>++<referenced period specification> ::=+  PERIOD <application time period name>++defintely skip++<referential triggered action> ::=+    <update rule> [ <delete rule> ]+  | <delete rule> [ <update rule> ]++<update rule> ::=+  ON UPDATE <referential action>++<delete rule> ::=+  ON DELETE <referential action>++<referential action> ::=+    CASCADE+  | SET NULL+  | SET DEFAULT+  | RESTRICT+  | NO ACTION++++11.9 <check constraint definition>++<check  constraint definition> ::=+     CHECK <left paren> <search condition> <right paren>++>     ,(TestStatement ansi2011+>       "create table t (a int, b int, \n\+>       \                check (a > b));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef Nothing $+>             TableCheckConstraint+>             (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))+>        ])+++>     ,(TestStatement ansi2011+>       "create table t (a int, b int, \n\+>       \                constraint agtb check (a > b));"+>      $ CreateTable [Name Nothing "t"]+>        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []+>        ,TableConstraintDef (Just [Name Nothing "agtb"]) $+>             TableCheckConstraint+>             (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))+>        ])+++TODO: lots more combos of table elements+and types and the other bits in a column def++11.10 <alter table statement>++<alter table statement> ::=+  ALTER TABLE <table name> <alter table action>++<alter table action> ::=+    <add column definition>+  | <alter column definition>+  | <drop column definition>+  | <add table constraint definition>+  | <alter table constraint definition>+  | <drop table constraint definition>+  | <add table period definition>+  | <drop table period definition>+  | <add system versioning clause>+  | <drop system versioning clause>++11.11 <add column definition>++<add column definition> ::=+  ADD [ COLUMN ] <column definition>++alter table t add column a int+alter table t add a int+alter table t add a int unique not null check (a>0)++>     ,(TestStatement ansi2011+>       "alter table t add column a int"+>      $ AlterTable [Name Nothing "t"] $ AddColumnDef+>        $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []+>        )++todo: more add column++11.12 <alter column definition>++<alter column definition> ::=+  ALTER [ COLUMN ] <column name> <alter column action>++<alter column action> ::=+    <set column default clause>+  | <drop column default clause>+  | <set column not null clause>+  | <drop column not null clause>+  | <add column scope clause>+  | <drop column scope clause>+  | <alter column data type clause>+  | <alter identity column specification>+  | <drop identity property clause>+  | <drop column generation expression clause>+++11.13 <set column default clause>++<set column default clause> ::=+  SET <default clause>+++>     ,(TestStatement ansi2011+>       "alter table t alter column c set default 0"+>      $ AlterTable [Name Nothing "t"] $ AlterColumnSetDefault (Name Nothing "c")+>        $ NumLit "0")++11.14 <drop column default clause>++<drop column default clause> ::=+  DROP DEFAULT++>     ,(TestStatement ansi2011+>       "alter table t alter column c drop default"+>      $ AlterTable [Name Nothing "t"] $ AlterColumnDropDefault (Name Nothing "c"))+++11.15 <set column not null clause>++<set column not null clause> ::=+  SET NOT NULL++>     ,(TestStatement ansi2011+>       "alter table t alter column c set not null"+>      $ AlterTable [Name Nothing "t"] $ AlterColumnSetNotNull (Name Nothing "c"))++11.16 <drop column not null clause>++<drop column not null clause> ::=+  DROP NOT NULL++>     ,(TestStatement ansi2011+>       "alter table t alter column c drop not null"+>      $ AlterTable [Name Nothing "t"] $ AlterColumnDropNotNull (Name Nothing "c"))++11.17 <add column scope clause>++<add column scope clause> ::=+  ADD <scope clause>++11.18 <drop column scope clause>++<drop column scope clause> ::=+  DROP SCOPE <drop behavior>++11.19 <alter column data type clause>++<alter column data type clause> ::=+  SET DATA TYPE <data type>++>     ,(TestStatement ansi2011+>       "alter table t alter column c set data type int;"+>      $ AlterTable [Name Nothing "t"] $+>        AlterColumnSetDataType (Name Nothing "c") (TypeName [Name Nothing "int"]))++++11.20 <alter identity column specification>++<alter identity column specification> ::=+    <set identity column generation clause> [ <alter identity column option>... ]+  | <alter identity column option>...++<set identity column generation clause> ::=+  SET GENERATED { ALWAYS | BY DEFAULT }++so you have to write set generated for alter identity?+and you have to use always or by default++makes no sense: if you just want to restart you have to explicitly set+the always or by default? you can't just leave it unchanged?++you don't write as identity like with create table, this is wrong:++alter table t alter column c set generated always as identity++but these are ok?++alter table t alter column c set generated always++alter table t alter column c set generated by default++<alter identity column option> ::=+    <alter sequence generator restart option>+  | SET <basic sequence generator option>++alter table t alter column c set generated always restart+alter table t alter column c set generated always restart with 4++you can just write restart++but to write others you have to repeat set? each time?++alter table t alter column c set generated always set increment by 5 set minvalue 0 set maxvalue 5 set cycle restart with 5+(no set before the restart++in create table, it looks like this:++c int generated generated always as identity (increment by 5 minvalue 0 maxvalue 5 cycle restart with 5)++why gratuituous differences???++is there no way to do this:++alter table t alter column c set generated as (a * 3)+??++UPDATE: alter sequence uses same syntax as create sequence, which is+the same sytnax as identity in create table, so overrule the sql+standard and use the same syntax in alter identity.++PLAN: TODO++don't implement alter table alter column generated now++review the syntax for generated in db2, oracle, sql server, postgres, others?++observe which features are supported, and the consistency between+create table and alter table++try to find some people to ask if the standard really is this much of+a mess or I have misunderstood the grammer, or maybe there is a good+reason for the inconsistencies?+++11.21 <drop identity property clause>++<drop identity property clause> ::=+  DROP IDENTITY++alter table t alter column c drop identity++included in the generated plan above++11.22 <drop column generation expression clause>++<drop column generation expression clause> ::=+  DROP EXPRESSION++alter table t alter column c drop expression++included in the generated plan above+++11.23 <drop column definition>++<drop column definition> ::=+  DROP [ COLUMN ] <column name> <drop behavior>++>     ,(TestStatement ansi2011+>       "alter table t drop column c"+>      $ AlterTable [Name Nothing "t"] $+>        DropColumn (Name Nothing "c") DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "alter table t drop c cascade"+>      $ AlterTable [Name Nothing "t"] $+>        DropColumn (Name Nothing "c") Cascade)++>     ,(TestStatement ansi2011+>       "alter table t drop c restrict"+>      $ AlterTable [Name Nothing "t"] $+>        DropColumn (Name Nothing "c") Restrict)++++11.24 <add table constraint definition>++<add table constraint definition> ::=+  ADD <table constraint definition>++>     ,(TestStatement ansi2011+>       "alter table t add constraint c unique (a,b)"+>      $ AlterTable [Name Nothing "t"] $+>        AddTableConstraintDef (Just [Name Nothing "c"])+>             $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])++>     ,(TestStatement ansi2011+>       "alter table t add unique (a,b)"+>      $ AlterTable [Name Nothing "t"] $+>        AddTableConstraintDef Nothing+>             $ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])+++11.25 <alter table constraint definition>+<alter table constraint definition> ::=+  ALTER CONSTRAINT <constraint name> <constraint enforcement>++todo++11.26 <drop table constraint definition>++<drop table constraint definition> ::=+  DROP CONSTRAINT <constraint name> <drop behavior>++>     ,(TestStatement ansi2011+>       "alter table t drop constraint c"+>      $ AlterTable [Name Nothing "t"] $+>        DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "alter table t drop constraint c restrict"+>      $ AlterTable [Name Nothing "t"] $+>        DropTableConstraintDef [Name Nothing "c"] Restrict)++11.27 <add table period definition>++<add table period definition> ::=+  ADD <table period definition> [ <add system time period column list> ]++defintely skip++<add system time period column list> ::=+  ADD [ COLUMN ] <column definition 1> ADD [ COLUMN ] <column definition 2>++defintely skip++<column definition 1> ::=+  <column definition>++defintely skip++<column definition 2> ::=+  <column definition>++defintely skip++11.28 <drop table period definition>++<drop table period definition> ::=+  DROP <system or application time period specification> <drop behavior>++defintely skip++11.29 <add system versioning clause>++<add system versioning clause> ::=+  ADD <system versioning clause>++defintely skip++11.30 <drop system versioning clause>++<drop system versioning clause> ::=+  DROP SYSTEM VERSIONING <drop behavior>++defintely skip++11.31 <drop table statement>++<drop table statement> ::=+  DROP TABLE <table name> <drop behavior>++>     ,(TestStatement ansi2011+>       "drop table t"+>      $ DropTable [Name Nothing "t"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "drop table t restrict"+>      $ DropTable [Name Nothing "t"] Restrict)+++11.32 <view definition>++<view definition> ::=+  CREATE [ RECURSIVE ] VIEW <table name> <view specification>+      AS <query expression> [ WITH [ <levels clause> ] CHECK OPTION ]++<view specification> ::=+    <regular view specification>+  | <referenceable view specification>++<regular view specification> ::=+  [ <left paren> <view column list> <right paren> ]++<referenceable view specification> ::=+  OF <path-resolved user-defined type name> [ <subview clause> ]+      [ <view element list> ]++<subview clause> ::=+  UNDER <table name>++<view element list> ::=+  <left paren> <view element> [ { <comma> <view element> }... ] <right paren>++<view element> ::=+    <self-referencing column specification>+  | <view column option>++<view column option> ::=+  <column name> WITH OPTIONS <scope clause>++<levels clause> ::=+    CASCADED+  | LOCAL++<view column list> ::=+  <column name list>++>     ,(TestStatement ansi2011+>       "create view v as select * from t"+>      $ CreateView False [Name Nothing "v"] Nothing (makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }) Nothing)+++>     ,(TestStatement ansi2011+>       "create recursive view v as select * from t"+>      $ CreateView True [Name Nothing "v"] Nothing (makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }) Nothing)++>     ,(TestStatement ansi2011+>       "create view v(a,b) as select * from t"+>      $ CreateView False [Name Nothing "v"] (Just [Name Nothing "a", Name Nothing "b"])+>          (makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }) Nothing)+++>     ,(TestStatement ansi2011+>       "create view v as select * from t with check option"+>      $ CreateView False [Name Nothing "v"] Nothing (makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }) (Just DefaultCheckOption))++>     ,(TestStatement ansi2011+>       "create view v as select * from t with cascaded check option"+>      $ CreateView False [Name Nothing "v"] Nothing (makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }) (Just CascadedCheckOption))++>     ,(TestStatement ansi2011+>       "create view v as select * from t with local check option"+>      $ CreateView False [Name Nothing "v"] Nothing+>          (makeSelect+>          {qeSelectList = [(Star, Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }) (Just LocalCheckOption))+++11.33 <drop view statement>++<drop view statement> ::=+  DROP VIEW <table name> <drop behavior>+++>     ,(TestStatement ansi2011+>       "drop view v"+>      $ DropView [Name Nothing "v"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "drop view v cascade"+>      $ DropView [Name Nothing "v"] Cascade)+++11.34 <domain definition>++<domain definition> ::=+  CREATE DOMAIN <domain name> [ AS ] <predefined type>+      [ <default clause> ]+      [ <domain constraint>... ]+      [ <collate clause> ]++<domain constraint> ::=+  [ <constraint name definition> ] <check constraint definition> [+      <constraint characteristics> ]++>     ,(TestStatement ansi2011+>       "create domain my_int int"+>      $ CreateDomain [Name Nothing "my_int"]+>           (TypeName [Name Nothing "int"])+>           Nothing [])++>     ,(TestStatement ansi2011+>       "create domain my_int as int"+>      $ CreateDomain [Name Nothing "my_int"]+>           (TypeName [Name Nothing "int"])+>           Nothing [])++>     ,(TestStatement ansi2011+>       "create domain my_int int default 0"+>      $ CreateDomain [Name Nothing "my_int"]+>           (TypeName [Name Nothing "int"])+>           (Just (NumLit "0")) [])++>     ,(TestStatement ansi2011+>       "create domain my_int int check (value > 5)"+>      $ CreateDomain [Name Nothing "my_int"]+>           (TypeName [Name Nothing "int"])+>           Nothing [(Nothing+>                    ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])++>     ,(TestStatement ansi2011+>       "create domain my_int int constraint gt5 check (value > 5)"+>      $ CreateDomain [Name Nothing "my_int"]+>           (TypeName [Name Nothing "int"])+>           Nothing [(Just [Name Nothing "gt5"]+>                    ,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])++++11.35 <alter domain statement>++<alter domain statement> ::=+  ALTER DOMAIN <domain name> <alter domain action>++<alter domain action> ::=+    <set domain default clause>+  | <drop domain default clause>+  | <add domain constraint definition>+  | <drop domain constraint definition>++11.36 <set domain default clause>++<set domain default clause> ::=+  SET <default clause>++>     ,(TestStatement ansi2011+>       "alter domain my_int set default 0"+>      $ AlterDomain [Name Nothing "my_int"]+>        $ ADSetDefault $ NumLit "0")+++11.37 <drop domain default clause>++<drop domain default clause> ::=+  DROP DEFAULT++>     ,(TestStatement ansi2011+>       "alter domain my_int drop default"+>      $ AlterDomain [Name Nothing "my_int"]+>        $ ADDropDefault)+++11.38 <add domain constraint definition>++<add domain constraint definition> ::=+  ADD <domain constraint>++>     ,(TestStatement ansi2011+>       "alter domain my_int add check (value > 6)"+>      $ AlterDomain [Name Nothing "my_int"]+>        $ ADAddConstraint Nothing+>          $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))++>     ,(TestStatement ansi2011+>       "alter domain my_int add constraint gt6 check (value > 6)"+>      $ AlterDomain [Name Nothing "my_int"]+>        $ ADAddConstraint (Just [Name Nothing "gt6"])+>          $ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))+++11.39 <drop domain constraint definition>++<drop domain constraint definition> ::=+  DROP CONSTRAINT <constraint name>++>     ,(TestStatement ansi2011+>       "alter domain my_int drop constraint gt6"+>      $ AlterDomain [Name Nothing "my_int"]+>        $ ADDropConstraint [Name Nothing "gt6"])++11.40 <drop domain statement>++<drop domain statement> ::=+  DROP DOMAIN <domain name> <drop behavior>++>     ,(TestStatement ansi2011+>       "drop domain my_int"+>      $ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "drop domain my_int cascade"+>      $ DropDomain [Name Nothing "my_int"] Cascade)++++11.41 <character set definition>++<character set definition> ::=+  CREATE CHARACTER SET <character set name> [ AS ]+      <character set source> [ <collate clause> ]++<character set source> ::=+  GET <character set specification>++11.42 <drop character set statement>++<drop character set statement> ::=+  DROP CHARACTER SET <character set name>++11.43 <collation definition>++<collation definition> ::=+  CREATE COLLATION <collation name> FOR <character set specification>+      FROM <existing collation name> [ <pad characteristic> ]++<existing collation name> ::=+  <collation name>++<pad characteristic> ::=+    NO PAD+  | PAD SPACE++11.44 <drop collation statement>++<drop collation statement> ::=+  DROP COLLATION <collation name> <drop behavior>++11.45 <transliteration definition>++<transliteration definition> ::=+  CREATE TRANSLATION <transliteration name> FOR <source character set specification>+      TO <target character set specification> FROM <transliteration source>++<source character set specification> ::=+  <character set specification>++<target character set specification> ::=+  <character set specification>++<transliteration source> ::=+    <existing transliteration name>+  | <transliteration routine>++<existing transliteration name> ::=+  <transliteration name>++<transliteration routine> ::=+  <specific routine designator>++11.46 <drop transliteration statement>++<drop transliteration statement> ::=+  DROP TRANSLATION <transliteration name>++11.47 <assertion definition>++<assertion definition> ::=+     CREATE ASSERTION <constraint name>+         CHECK <left paren> <search condition> <right paren>+         [ <constraint characteristics> ]++>     ,(TestStatement ansi2011+>       "create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);"+>      $ CreateAssertion [Name Nothing "t1_not_empty"]+>         $ BinOp (SubQueryExpr SqSq $+>                  makeSelect+>                  {qeSelectList = [(App [Name Nothing "count"] [Star],Nothing)]+>                  ,qeFrom = [TRSimple [Name Nothing "t1"]]+>                  })+>                 [Name Nothing ">"] (NumLit "0"))++11.48 <drop assertion statement>++<drop assertion statement> ::=+  DROP ASSERTION <constraint name> [ <drop behavior> ]++>     ,(TestStatement ansi2011+>       "drop assertion t1_not_empty;"+>      $ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "drop assertion t1_not_empty cascade;"+>      $ DropAssertion [Name Nothing "t1_not_empty"] Cascade)+++11.49 <trigger definition>++<trigger definition> ::=+  CREATE TRIGGER <trigger name> <trigger action time> <trigger event>+      ON <table name> [ REFERENCING <transition table or variable list> ]+      <triggered action>++<trigger action time> ::=+    BEFORE+  | AFTER+  | INSTEAD OF++<trigger event> ::=+    INSERT+  | DELETE+  | UPDATE [ OF <trigger column list> ]++<trigger column list> ::=+  <column name list>++<triggered action> ::=+  [ FOR EACH { ROW | STATEMENT } ]+      [ <triggered when clause> ]+      <triggered SQL statement>++<triggered when clause> ::=+  WHEN <left paren> <search condition> <right paren>++<triggered SQL statement> ::=+    <SQL procedure statement>+  | BEGIN ATOMIC { <SQL procedure statement> <semicolon> }... END++<transition table or variable list> ::=+  <transition table or variable>...++<transition table or variable> ::=+    OLD [ ROW ] [ AS     ] <old transition variable name>+  | NEW [ ROW ] [ AS     ] <new transition variable name>+  | OLD TABLE [ AS ]     <old transition table name>+  | NEW TABLE [ AS ]     <new transition table name>++<old transition table name> ::=+  <transition table name>++<new transition table name> ::=+  <transition table name>++<transition table name> ::=+  <identifier>++<old transition variable name> ::=+  <correlation name>++<new transition variable name> ::=+  <correlation name>++11.50 <drop trigger statement>++<drop trigger statement> ::=+  DROP TRIGGER <trigger name>++11.51 <user-defined type definition>++<user-defined type definition> ::=+  CREATE TYPE <user-defined type body>++ <user-defined type body> ::=+  <schema-resolved user-defined type name>+      [ <subtype clause> ]+      [ AS <representation> ]+      [ <user-defined type option list> ]+      [ <method specification list> ]++<user-defined type option list> ::=+  <user-defined type option> [ <user-defined type option>... ]++<user-defined type option> ::=+    <instantiable clause>+  | <finality>+  | <reference type specification>+  | <cast to ref>+  | <cast to type>+  | <cast to distinct>+  | <cast to source>++<subtype clause> ::=+  UNDER <supertype name>++<supertype name> ::=+  <path-resolved user-defined type name>++<representation> ::=+    <predefined type>+  | <collection type>+  | <member list>++<member list> ::=+  <left paren> <member> [ { <comma> <member> }... ] <right paren>++<member> ::=+  <attribute definition>++<instantiable clause> ::=+    INSTANTIABLE+  | NOT INSTANTIABLE++<finality> ::=+    FINAL+  | NOT FINAL++<reference type specification> ::=+    <user-defined representation>+  | <derived representation>+  | <system-generated representation>++<user-defined representation> ::=+  REF USING <predefined type>++<derived representation> ::=+  REF FROM <list of attributes>++<system-generated representation> ::=+  REF IS SYSTEM GENERATED++<cast to ref> ::=+  CAST <left paren> SOURCE AS REF <right paren> WITH <cast to ref identifier>++<cast to ref identifier> ::=+  <identifier>++<cast to type> ::=+  CAST <left paren> REF AS SOURCE <right paren> WITH <cast to type identifier>++<cast to type identifier> ::=+  <identifier>++<list of attributes> ::=+  <left paren> <attribute name> [ { <comma> <attribute name> }... ] <right paren>++<cast to distinct> ::=+  CAST <left paren> SOURCE AS DISTINCT <right paren>+      WITH <cast to distinct identifier>++<cast to distinct identifier> ::=+  <identifier>++<cast to source> ::=+  CAST <left paren> DISTINCT AS SOURCE <right paren>+      WITH <cast to source identifier>++<cast to source identifier> ::=+  <identifier>++<method specification list> ::=+  <method specification> [ { <comma> <method specification> }... ]++<method specification> ::=+    <original method specification>+  | <overriding method specification>++<original method specification> ::=+  <partial method specification> [ SELF AS RESULT ] [ SELF AS LOCATOR ]+      [ <method characteristics> ]++<overriding method specification> ::=+  OVERRIDING <partial method specification>+                                                                                1<partial method specification> ::=+  [ INSTANCE | STATIC | CONSTRUCTOR ]+      METHOD <method name> <SQL parameter declaration list>+      <returns clause>+      [ SPECIFIC <specific method name> ]++<specific method name> ::=+  [ <schema name> <period> ] <qualified identifier>++<method characteristics> ::=+  <method characteristic>...++ <method characteristic> ::=+         <language clause>+     |   <parameter style clause>+     |   <deterministic characteristic>+     |   <SQL-data access indication>+     |   <null-call clause>++11.52 <attribute definition>++<attribute definition> ::=+     <attribute name> <data type>+         [ <attribute default> ]+         [ <collate clause> ]++<attribute default> ::=+  <default clause>++11.53 <alter type statement>++<alter type statement> ::=+  ALTER TYPE <schema-resolved user-defined type name> <alter type action>++<alter type action> ::=+    <add attribute definition>+  | <drop attribute definition>+  | <add original method specification>+  | <add overriding method specification>+  | <drop method specification>++11.54 <add attribute definition>++<add attribute definition> ::=+  ADD ATTRIBUTE <attribute definition>++11.55 <drop attribute definition>++<drop attribute definition> ::=+  DROP ATTRIBUTE <attribute name> RESTRICT++11.56 <add original method specification>++<add original method specification> ::=+  ADD <original method specification>++11.57 <add overriding method specification>++<add overriding method specification> ::=+  ADD <overriding method specification>++11.58 <drop method specification>++<drop method specification> ::=+  DROP <specific method specification designator> RESTRICT++<specific method specification designator> ::=+  [ INSTANCE | STATIC | CONSTRUCTOR ]+      METHOD <method name> <data type list>++11.59 <drop data type statement>++<drop data type statement> ::=+  DROP TYPE <schema-resolved user-defined type name> <drop behavior>++11.60 <SQL-invoked routine>++<SQL-invoked routine> ::=+  <schema routine>++<schema routine> ::=+    <schema procedure>+  | <schema function>++<schema procedure> ::=+  CREATE <SQL-invoked procedure>++<schema function> ::=+  CREATE <SQL-invoked function>++<SQL-invoked procedure> ::=+  PROCEDURE <schema qualified routine name> <SQL parameter declaration list>+      <routine characteristics>+      <routine body>++<SQL-invoked function> ::=+  { <function specification> | <method specification designator> } <routine body>++<SQL parameter declaration list> ::=+  <left paren> [ <SQL parameter declaration>+      [ { <comma> <SQL parameter declaration> }... ] ] <right paren>++<SQL parameter declaration> ::=+  [ <parameter mode> ]+      [ <SQL parameter name> ]+      <parameter type> [ RESULT ]+      [ DEFAULT <parameter default> ]++<parameter default> ::=+    <value expression>+  | <contextually typed value specification>++<parameter mode> ::=+    IN+  | OUT+  | INOUT++<parameter type> ::=+  <data type> [ <locator indication> ]++<locator indication> ::=+  AS LOCATOR++<function specification> ::=+  FUNCTION <schema qualified routine name> <SQL parameter declaration list>+      <returns clause>+      <routine characteristics>+      [ <dispatch clause> ]++<method specification designator> ::=+    SPECIFIC METHOD <specific method name>+  | [ INSTANCE | STATIC | CONSTRUCTOR ]+      METHOD <method name> <SQL parameter declaration list>+      [ <returns clause> ]+      FOR <schema-resolved user-defined type name>++<routine characteristics> ::=+  [ <routine characteristic>... ]++<routine characteristic> ::=+    <language clause>+  | <parameter style clause>+  | SPECIFIC <specific name>+  | <deterministic characteristic>+  | <SQL-data access indication>+  | <null-call clause>+  | <returned result sets characteristic>+  | <savepoint level indication>++<savepoint level indication> ::=+    NEW SAVEPOINT LEVEL+  | OLD SAVEPOINT LEVEL++<returned result sets characteristic> ::=+  DYNAMIC RESULT SETS <maximum returned result sets>++<parameter style clause> ::=+  PARAMETER STYLE <parameter style>++<dispatch clause> ::=+  STATIC DISPATCH++<returns clause> ::=+  RETURNS <returns type>++<returns type> ::=+    <returns data type> [ <result cast> ]+  | <returns table type>++<returns table type> ::=+  TABLE <table function column list>++<table function column list> ::=+  <left paren> <table function column list element>+      [ { <comma> <table function column list element> }... ] <right paren>++<table function column list element> ::=+  <column name> <data type>++<result cast> ::=+  CAST FROM <result cast from type>++<result cast from type> ::=+  <data type> [ <locator indication> ]++<returns data type> ::=+  <data type> [ <locator indication> ]++<routine body> ::=+    <SQL routine spec>+  | <external body reference>++<SQL routine spec> ::=+  [ <rights clause> ] <SQL routine body>++<rights clause> ::=+    SQL SECURITY INVOKER+  | SQL SECURITY DEFINER++<SQL routine body> ::=+  <SQL procedure statement>++<external body reference> ::=+  EXTERNAL [ NAME <external routine name> ]+      [ <parameter style clause> ]+      [ <transform group specification> ]+      [ <external security clause> ]++<external security clause> ::=+    EXTERNAL SECURITY DEFINER+  | EXTERNAL SECURITY INVOKER+  | EXTERNAL SECURITY IMPLEMENTATION DEFINED++<parameter style> ::=+    SQL+  | GENERAL++<deterministic characteristic> ::=+    DETERMINISTIC+  | NOT DETERMINISTIC++<SQL-data access indication> ::=+    NO SQL+  | CONTAINS SQL+  | READS SQL DATA+  | MODIFIES SQL DATA++<null-call clause> ::=+    RETURNS NULL ON NULL INPUT+  | CALLED ON NULL INPUT++<maximum returned result sets> ::=+  <unsigned integer>++<transform group specification> ::=+  TRANSFORM GROUP { <single group specification> | <multiple group specification> }++<single group specification> ::=+  <group name>++<multiple group specification> ::=+  <group specification> [ { <comma> <group specification> }... ]++<group specification> ::=+  <group name> FOR TYPE <path-resolved user-defined type name>++11.61 <alter routine statement>++<alter routine statement> ::=+  ALTER <specific routine designator>+      <alter routine characteristics> <alter routine behavior>++<alter routine characteristics> ::=+  <alter routine characteristic>...++<alter routine characteristic> ::=+    <language clause>+  | <parameter style clause>+  | <SQL-data access indication>+  | <null-call clause>+  | <returned result sets characteristic>+  | NAME <external routine name>++<alter routine behavior> ::=+  RESTRICT++11.62 <drop routine statement>++<drop routine statement> ::=+  DROP <specific routine designator> <drop behavior>++11.63 <user-defined cast definition>++<user-defined cast definition> ::=+  CREATE CAST <left paren> <source data type> AS <target data type> <right paren>+      WITH <cast function>+      [ AS ASSIGNMENT ]++<cast function> ::=+  <specific routine designator>++<source data type> ::=+  <data type>++<target data type> ::=+  <data type>++11.64 <drop user-defined cast statement>++<drop user-defined cast statement> ::=+  DROP CAST <left paren> <source data type> AS <target data type> <right paren>+      <drop behavior>++11.65 <user-defined ordering definition>++<user-defined ordering definition> ::=+  CREATE ORDERING FOR <schema-resolved user-defined type name> <ordering form>++<ordering form> ::=+    <equals ordering form>+  | <full ordering form>++<equals ordering form> ::=+  EQUALS ONLY BY <ordering category>++<full ordering form> ::=+  ORDER FULL BY <ordering category>++<ordering category> ::=+    <relative category>+  | <map category>+  | <state category>++<relative category> ::=+  RELATIVE WITH <relative function specification>++<map category> ::=+  MAP WITH <map function specification>++<state category> ::=+  STATE [ <specific name> ]++<relative function specification> ::=+  <specific routine designator>++<map function specification> ::=+  <specific routine designator>++11.66 <drop user-defined ordering statement>++<drop user-defined ordering statement> ::=+  DROP ORDERING FOR <schema-resolved user-defined type name> <drop behavior>++11.67 <transform definition>++<transform definition> ::=+  CREATE { TRANSFORM | TRANSFORMS } FOR+      <schema-resolved user-defined type name> <transform group>...++<transform group> ::=+  <group name> <left paren> <transform element list> <right paren>++<group name> ::=+  <identifier>++<transform element list> ::=+  <transform element> [ <comma> <transform element> ]++<transform element> ::=+    <to sql>+  | <from sql>++<to sql> ::=+  TO SQL WITH <to sql function>++<from sql> ::=+  FROM SQL WITH <from sql function>++<to sql function> ::=+  <specific routine designator>++<from sql function> ::=+  <specific routine designator>++11.68 <alter transform statement>++<alter transform statement> ::=+  ALTER { TRANSFORM | TRANSFORMS }+      FOR <schema-resolved user-defined type name> <alter group>...++<alter group> ::=+  <group name> <left paren> <alter transform action list> <right paren>++<alter transform action list> ::=+  <alter transform action> [ { <comma> <alter transform action> }... ]++<alter transform action> ::=+    <add transform element list>+  | <drop transform element list>++11.69 <add transform element list>++<add transform element list> ::=+  ADD <left paren> <transform element list> <right paren>++11.70 <drop transform element list>++<drop transform element list> ::=+  DROP <left paren> <transform kind>+      [ <comma> <transform kind> ] <drop behavior> <right paren>++<transform kind> ::=+    TO SQL+  | FROM SQL++11.71 <drop transform statement>++<drop transform statement> ::=+  DROP { TRANSFORM | TRANSFORMS } <transforms to be dropped>+      FOR <schema-resolved user-defined type name> <drop behavior>++<transforms to be dropped> ::=+    ALL+  | <transform group element>++<transform group element> ::=+  <group name>++11.72 <sequence generator definition>++<sequence generator definition> ::=+  CREATE SEQUENCE <sequence generator name> [ <sequence generator options> ]++<sequence generator options> ::=+  <sequence generator option>...++<sequence generator option> ::=+    <sequence generator data type option>+  | <common sequence generator options>++<common sequence generator options> ::=+  <common sequence generator option>...++<common sequence generator option> ::=+    <sequence generator start with option>+  | <basic sequence generator option>++<basic sequence generator option> ::=+    <sequence generator increment by option>+  | <sequence generator maxvalue option>+  | <sequence generator minvalue option>+  | <sequence generator cycle option>++<sequence generator data type option> ::=+  AS <data type>++<sequence generator start with option> ::=+  START WITH <sequence generator start value>++<sequence generator start value> ::=+  <signed numeric literal>++<sequence generator increment by option> ::=+  INCREMENT BY <sequence generator increment>++<sequence generator increment> ::=+  <signed numeric literal>++<sequence generator maxvalue option> ::=+    MAXVALUE <sequence generator max value>+  | NO MAXVALUE++<sequence generator max value> ::=+  <signed numeric literal>++<sequence generator minvalue option> ::=+    MINVALUE <sequence generator min value>+  | NO MINVALUE++<sequence generator min value> ::=+  <signed numeric literal>++<sequence generator cycle option> ::=+    CYCLE+  | NO CYCLE++>     ,(TestStatement ansi2011+>       "create sequence seq"+>      $ CreateSequence [Name Nothing "seq"] [])++>     ,(TestStatement ansi2011+>       "create sequence seq as bigint"+>      $ CreateSequence [Name Nothing "seq"]+>         [SGODataType $ TypeName [Name Nothing "bigint"]])++>     ,(TestStatement ansi2011+>       "create sequence seq as bigint start with 5"+>      $ CreateSequence [Name Nothing "seq"]+>         [SGOStartWith 5+>         ,SGODataType $ TypeName [Name Nothing "bigint"]+>         ])+++11.73 <alter sequence generator statement>++<alter sequence generator statement> ::=+  ALTER SEQUENCE <sequence generator name> <alter sequence generator options>++<alter sequence generator options> ::=+  <alter sequence generator option>...++<alter sequence generator option> ::=+    <alter sequence generator restart option>+  | <basic sequence generator option>++<alter sequence generator restart option> ::=+  RESTART [ WITH <sequence generator restart value> ]++<sequence generator restart value> ::=+  <signed numeric literal>++>     ,(TestStatement ansi2011+>       "alter sequence seq restart"+>      $ AlterSequence [Name Nothing "seq"]+>         [SGORestart Nothing])++>     ,(TestStatement ansi2011+>       "alter sequence seq restart with 5"+>      $ AlterSequence [Name Nothing "seq"]+>         [SGORestart $ Just 5])++>     ,(TestStatement ansi2011+>       "alter sequence seq restart with 5 increment by 5"+>      $ AlterSequence [Name Nothing "seq"]+>         [SGORestart $ Just 5+>         ,SGOIncrementBy 5])+++11.74 <drop sequence generator statement>++<drop sequence generator statement> ::=+  DROP SEQUENCE <sequence generator name> <drop behavior>++>     ,(TestStatement ansi2011+>       "drop sequence seq"+>      $ DropSequence [Name Nothing "seq"] DefaultDropBehaviour)++>     ,(TestStatement ansi2011+>       "drop sequence seq restrict"+>      $ DropSequence [Name Nothing "seq"] Restrict)+++>     ]
+ tools/Language/SQL/SimpleSQL/ScalarExprs.lhs view
@@ -0,0 +1,415 @@++Tests for parsing scalar expressions++> module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where++> import Language.SQL.SimpleSQL.TestTypes+> import Language.SQL.SimpleSQL.Syntax++> scalarExprTests :: TestItem+> scalarExprTests = Group "scalarExprTests"+>     [literals+>     ,identifiers+>     ,star+>     ,parameter+>     ,dots+>     ,app+>     ,caseexp+>     ,operators+>     ,parens+>     ,subqueries+>     ,aggregates+>     ,windowFunctions+>     ,functionsWithReservedNames+>     ]++> literals :: TestItem+> literals = Group "literals" $ map (uncurry (TestScalarExpr ansi2011))+>     [("3", NumLit "3")+>      ,("3.", NumLit "3.")+>      ,("3.3", NumLit "3.3")+>      ,(".3", NumLit ".3")+>      ,("3.e3", NumLit "3.e3")+>      ,("3.3e3", NumLit "3.3e3")+>      ,(".3e3", NumLit ".3e3")+>      ,("3e3", NumLit "3e3")+>      ,("3e+3", NumLit "3e+3")+>      ,("3e-3", NumLit "3e-3")+>      ,("'string'", StringLit "'" "'" "string")+>      ,("'string with a '' quote'", StringLit "'" "'" "string with a '' quote")+>      ,("'1'", StringLit "'" "'" "1")+>      ,("interval '3' day"+>       ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)+>      ,("interval '3' day (3)"+>       ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing)+>      ,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks")+>     ]++> identifiers :: TestItem+> identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))+>     [("iden1", Iden [Name Nothing "iden1"])+>     --,("t.a", Iden2 "t" "a")+>     ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])+>     ]++> star :: TestItem+> star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))+>     [("*", Star)+>     --,("t.*", Star2 "t")+>     --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])+>     ]++> parameter :: TestItem+> parameter = Group "parameter"+>     [TestScalarExpr ansi2011 "?" Parameter+>     ,TestScalarExpr postgres "$13" $ PositionalArg 13]+++> dots :: TestItem+> dots = Group "dot" $ map (uncurry (TestScalarExpr ansi2011))+>     [("t.a", Iden [Name Nothing "t",Name Nothing "a"])+>     ,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star)+>     ,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"])+>     ,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"])+>     ]++> app :: TestItem+> app = Group "app" $ map (uncurry (TestScalarExpr ansi2011))+>     [("f()", App [Name Nothing "f"] [])+>     ,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]])+>     ,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])+>     ]++> caseexp :: TestItem+> caseexp = Group "caseexp" $ map (uncurry (TestScalarExpr ansi2011))+>     [("case a when 1 then 2 end"+>      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]+>                               ,NumLit "2")] Nothing)++>     ,("case a when 1 then 2 when 3 then 4 end"+>      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")+>                              ,([NumLit "3"], NumLit "4")] Nothing)++>     ,("case a when 1 then 2 when 3 then 4 else 5 end"+>      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")+>                              ,([NumLit "3"], NumLit "4")]+>                              (Just $ NumLit "5"))++>     ,("case when a=1 then 2 when a=3 then 4 else 5 end"+>      ,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2")+>                    ,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")]+>                    (Just $ NumLit "5"))++>     ,("case a when 1,2 then 10 when 3,4 then 20 end"+>      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"]+>                                ,NumLit "10")+>                              ,([NumLit "3",NumLit "4"]+>                                ,NumLit "20")]+>                              Nothing)++>     ]++> operators :: TestItem+> operators = Group "operators"+>     [binaryOperators+>     ,unaryOperators+>     ,casts+>     ,miscOps]++> binaryOperators :: TestItem+> binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+>     [("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))+>      -- sanity check fixities+>      -- todo: add more fixity checking++>     ,("a + b * c"+>      ,BinOp  (Iden [Name Nothing "a"]) [Name Nothing "+"]+>              (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])))++>     ,("a * b + c"+>      ,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"]))+>             [Name Nothing "+"] (Iden [Name Nothing "c"]))+>     ]++> unaryOperators :: TestItem+> unaryOperators = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+>     [("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])+>     ,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])+>     ,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"])+>     ,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"])+>     ]+++> casts :: TestItem+> casts = Group "operators" $ map (uncurry (TestScalarExpr ansi2011))+>     [("cast('1' as int)"+>      ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"])++>     ,("int '3'"+>      ,TypedLit (TypeName [Name Nothing "int"]) "3")++>     ,("cast('1' as double precision)"+>      ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])++>     ,("cast('1' as float(8))"+>      ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8)++>     ,("cast('1' as decimal(15,2))"+>      ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2)+++>     ,("double precision '3'"+>      ,TypedLit (TypeName [Name Nothing "double precision"]) "3")+>     ]++> subqueries :: TestItem+> subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+>     [("exists (select a from t)", SubQueryExpr SqExists ms)+>     ,("(select a from t)", SubQueryExpr SqSq ms)++>     ,("a in (select a from t)"+>      ,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))++>     ,("a not in (select a from t)"+>      ,In False (Iden [Name Nothing "a"]) (InQueryExpr ms))++>     ,("a > all (select a from t)"+>      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)++>     ,("a = some (select a from t)"+>      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms)++>     ,("a <= any (select a from t)"+>      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms)+>     ]+>   where+>     ms = makeSelect+>          {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]+>          ,qeFrom = [TRSimple [Name Nothing "t"]]+>          }++> miscOps :: TestItem+> miscOps = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))+>     [("a in (1,2,3)"+>      ,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"])++>     ,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"]))+>     ,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"]))+>     ,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"]))+>     ,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"]))+>     ,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"]))+>     ,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"]))+>     ,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"]))+>     ,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"]))+>     ,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"]))++>     ,("a is not distinct from b"+>      ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"]))++>     ,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"]))+>     ,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"]))+>     ,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"]))++>     ,("a is not similar to b"+>      ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"]))++>     ,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"]))+++special operators++>     ,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]+>                                                ,Iden [Name Nothing "b"]+>                                                ,Iden [Name Nothing "c"]])++>     ,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]+>                                                        ,Iden [Name Nothing "b"]+>                                                        ,Iden [Name Nothing "c"]])+>     ,("(1,2)"+>      ,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"])+++keyword special operators++>     ,("extract(day from t)"+>      , SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])++>     ,("substring(x from 1 for 2)"+>      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")+>                                                ,("for", NumLit "2")])++>     ,("substring(x from 1)"+>      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")])++>     ,("substring(x for 2)"+>      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")])++>     ,("substring(x from 1 for 2 collate C)"+>      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"])+>           [("from", NumLit "1")+>           ,("for", Collate (NumLit "2") [Name Nothing "C"])])++this doesn't work because of a overlap in the 'in' parser++>     ,("POSITION( string1 IN string2 )"+>      ,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])])++>     ,("CONVERT(char_value USING conversion_char_name)"+>      ,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])+>           [("using", Iden [Name Nothing "conversion_char_name"])])++>     ,("TRANSLATE(char_value USING translation_name)"+>      ,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"])+>           [("using", Iden [Name Nothing "translation_name"])])++OVERLAY(string PLACING embedded_string FROM start+[FOR length])++>     ,("OVERLAY(string PLACING embedded_string FROM start)"+>      ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])+>           [("placing", Iden [Name Nothing "embedded_string"])+>           ,("from", Iden [Name Nothing "start"])])++>     ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"+>      ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])+>           [("placing", Iden [Name Nothing "embedded_string"])+>           ,("from", Iden [Name Nothing "start"])+>           ,("for", Iden [Name Nothing "length"])])++TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]+target_string+[COLLATE collation_name] )++++>     ,("trim(from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("both", StringLit "'" "'" " ")+>           ,("from", Iden [Name Nothing "target_string"])])++>     ,("trim(leading from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("leading", StringLit "'" "'" " ")+>           ,("from", Iden [Name Nothing "target_string"])])++>     ,("trim(trailing from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("trailing", StringLit "'" "'" " ")+>           ,("from", Iden [Name Nothing "target_string"])])++>     ,("trim(both from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("both", StringLit "'" "'" " ")+>           ,("from", Iden [Name Nothing "target_string"])])+++>     ,("trim(leading 'x' from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("leading", StringLit "'" "'" "x")+>           ,("from", Iden [Name Nothing "target_string"])])++>     ,("trim(trailing 'y' from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("trailing", StringLit "'" "'" "y")+>           ,("from", Iden [Name Nothing "target_string"])])++>     ,("trim(both 'z' from target_string collate C)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("both", StringLit "'" "'" "z")+>           ,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])])++>     ,("trim(leading from target_string)"+>      ,SpecialOpK [Name Nothing "trim"] Nothing+>           [("leading", StringLit "'" "'" " ")+>           ,("from", Iden [Name Nothing "target_string"])])+++>     ]++> aggregates :: TestItem+> aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))+>     [("count(*)",App [Name Nothing "count"] [Star])++>     ,("sum(a order by a)"+>     ,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]+>                   [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing)++>     ,("sum(all a)"+>     ,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing)++>     ,("count(distinct a)"+>     ,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing)+>     ]++> windowFunctions :: TestItem+> windowFunctions = Group "windowFunctions" $ map (uncurry (TestScalarExpr ansi2011))+>     [("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing)+>     ,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing)++>     ,("max(a) over (partition by b)"+>      ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing)++>     ,("max(a) over (partition by b,c)"+>      ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing)++>     ,("sum(a) over (order by b)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []+>           [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing)++>     ,("sum(a) over (order by b desc,c)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []+>           [SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault+>           ,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)++>     ,("sum(a) over (partition by b order by c)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>           [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)++>     ,("sum(a) over (partition by b order by c range unbounded preceding)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+>       $ Just $ FrameFrom FrameRange UnboundedPreceding)++>     ,("sum(a) over (partition by b order by c range 5 preceding)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+>       $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))++>     ,("sum(a) over (partition by b order by c range current row)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+>       $ Just $ FrameFrom FrameRange Current)++>     ,("sum(a) over (partition by b order by c rows 5 following)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+>       $ Just $ FrameFrom FrameRows $ Following (NumLit "5"))++>     ,("sum(a) over (partition by b order by c range unbounded following)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+>       $ Just $ FrameFrom FrameRange UnboundedFollowing)++>     ,("sum(a) over (partition by b order by c \n\+>       \range between 5 preceding and 5 following)"+>      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]+>       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]+>       $ Just $ FrameBetween FrameRange+>                             (Preceding (NumLit "5"))+>                             (Following (NumLit "5")))++>     ]++> parens :: TestItem+> parens = Group "parens" $ map (uncurry (TestScalarExpr ansi2011))+>     [("(a)", Parens (Iden [Name Nothing "a"]))+>     ,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])))+>     ]++> functionsWithReservedNames :: TestItem+> functionsWithReservedNames = Group "functionsWithReservedNames" $ map t+>     ["abs"+>     ,"char_length"+>     ]+>   where+>     t fn = TestScalarExpr ansi2011 (fn ++ "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]
tools/Language/SQL/SimpleSQL/TableRefs.lhs view
@@ -9,97 +9,97 @@   > tableRefTests :: TestItem-> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr SQL2011))+> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011)) >     [("select a from t"->      ,ms [TRSimple [Name "t"]])+>      ,ms [TRSimple [Name Nothing "t"]])  >      ,("select a from f(a)"->       ,ms [TRFunction [Name "f"] [Iden [Name "a"]]])+>       ,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])  >     ,("select a from t,u"->      ,ms [TRSimple [Name "t"], TRSimple [Name "u"]])+>      ,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]])  >     ,("select a from s.t"->      ,ms [TRSimple [Name "s", Name "t"]])+>      ,ms [TRSimple [Name Nothing "s", Name Nothing "t"]])  these lateral queries make no sense but the syntax is valid  >     ,("select a from lateral a"->      ,ms [TRLateral $ TRSimple [Name "a"]])+>      ,ms [TRLateral $ TRSimple [Name Nothing "a"]])  >     ,("select a from lateral a,b"->      ,ms [TRLateral $ TRSimple [Name "a"], TRSimple [Name "b"]])+>      ,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]])  >     ,("select a from a, lateral b"->      ,ms [TRSimple [Name "a"], TRLateral $ TRSimple [Name "b"]])+>      ,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]])  >     ,("select a from a natural join lateral b"->      ,ms [TRJoin (TRSimple [Name "a"]) True JInner->                  (TRLateral $ TRSimple [Name "b"])+>      ,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner+>                  (TRLateral $ TRSimple [Name Nothing "b"]) >                  Nothing])  >     ,("select a from lateral a natural join lateral b"->      ,ms [TRJoin (TRLateral $ TRSimple [Name "a"]) True JInner->                  (TRLateral $ TRSimple [Name "b"])+>      ,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner+>                  (TRLateral $ TRSimple [Name Nothing "b"]) >                  Nothing])   >     ,("select a from t inner join u on expr"->      ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])->                        (Just $ JoinOn $ Iden [Name "expr"])])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])+>                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])  >     ,("select a from t join u on expr"->      ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])->                        (Just $ JoinOn $ Iden [Name "expr"])])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])+>                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])  >     ,("select a from t left join u on expr"->      ,ms [TRJoin (TRSimple [Name "t"]) False JLeft (TRSimple [Name "u"])->                        (Just $ JoinOn $ Iden [Name "expr"])])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"])+>                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])  >     ,("select a from t right join u on expr"->      ,ms [TRJoin (TRSimple [Name "t"]) False JRight (TRSimple [Name "u"])->                        (Just $ JoinOn $ Iden [Name "expr"])])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"])+>                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])  >     ,("select a from t full join u on expr"->      ,ms [TRJoin (TRSimple [Name "t"]) False JFull (TRSimple [Name "u"])->                        (Just $ JoinOn $ Iden [Name "expr"])])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"])+>                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])  >     ,("select a from t cross join u"->      ,ms [TRJoin (TRSimple [Name "t"]) False->                        JCross (TRSimple [Name "u"]) Nothing])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False+>                        JCross (TRSimple [Name Nothing "u"]) Nothing])  >     ,("select a from t natural inner join u"->      ,ms [TRJoin (TRSimple [Name "t"]) True JInner (TRSimple [Name "u"])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"]) >                        Nothing])  >     ,("select a from t inner join u using(a,b)"->      ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])->                        (Just $ JoinUsing [Name "a", Name "b"])])+>      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])+>                        (Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])])  >     ,("select a from (select a from t)"->      ,ms [TRQueryExpr $ ms [TRSimple [Name "t"]]])+>      ,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]])  >     ,("select a from t as u"->      ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)])+>      ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])  >     ,("select a from t u"->      ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)])+>      ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])  >     ,("select a from t u(b)"->      ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") $ Just [Name "b"])])+>      ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])])  >     ,("select a from (t cross join u) as u" >      ,ms [TRAlias (TRParens $->                    TRJoin (TRSimple [Name "t"]) False JCross (TRSimple [Name "u"]) Nothing)->                           (Alias (Name "u") Nothing)])+>                    TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing)+>                           (Alias (Name Nothing "u") Nothing)]) >      -- todo: not sure if the associativity is correct  >     ,("select a from t cross join u cross join v", >        ms [TRJoin->            (TRJoin (TRSimple [Name "t"]) False->                    JCross (TRSimple [Name "u"]) Nothing)->            False JCross (TRSimple [Name "v"]) Nothing])+>            (TRJoin (TRSimple [Name Nothing "t"]) False+>                    JCross (TRSimple [Name Nothing "u"]) Nothing)+>            False JCross (TRSimple [Name Nothing "v"]) Nothing]) >     ] >   where->     ms f = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]+>     ms f = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)] >                       ,qeFrom = f}
tools/Language/SQL/SimpleSQL/TestTypes.lhs view
@@ -4,9 +4,11 @@  > module Language.SQL.SimpleSQL.TestTypes >     (TestItem(..)->     ,Dialect(..)) where+>     ,ansi2011,mysql,postgres,oracle,sqlserver+>     ,allowOdbc) where  > import Language.SQL.SimpleSQL.Syntax+> import Language.SQL.SimpleSQL.Lex (Token)  TODO: maybe make the dialect args into [dialect], then each test checks all the dialects mentioned work, and all the dialects not@@ -14,9 +16,10 @@ to lots of tricky exceptions/variationsx.  > data TestItem = Group String [TestItem]->               | TestValueExpr Dialect String ValueExpr+>               | TestScalarExpr Dialect String ScalarExpr >               | TestQueryExpr Dialect String QueryExpr->               | TestQueryExprs Dialect String [QueryExpr]+>               | TestStatement Dialect String Statement+>               | TestStatements Dialect String [Statement]  this just checks the sql parses without error, mostly just a intermediate when I'm too lazy to write out the parsed AST. These@@ -27,5 +30,7 @@ check that the string given fails to parse  >               | ParseQueryExprFails Dialect String->               | ParseValueExprFails Dialect String+>               | ParseScalarExprFails Dialect String+>               | LexTest Dialect String [Token]+>               | LexFails Dialect String >                 deriving (Eq,Show)
tools/Language/SQL/SimpleSQL/Tests.lhs view
@@ -9,13 +9,13 @@ >     ,TestItem(..) >     ) where -> import Test.Framework-> import Test.Framework.Providers.HUnit-> import qualified Test.HUnit as H+> import qualified Test.Tasty as T+> import qualified Test.Tasty.HUnit as H  > --import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Pretty-> import Language.SQL.SimpleSQL.Parser+> import Language.SQL.SimpleSQL.Parse+> import Language.SQL.SimpleSQL.Lex  > import Language.SQL.SimpleSQL.TestTypes @@ -25,12 +25,19 @@ > import Language.SQL.SimpleSQL.QueryExprComponents > import Language.SQL.SimpleSQL.QueryExprs > import Language.SQL.SimpleSQL.TableRefs-> import Language.SQL.SimpleSQL.ValueExprs+> import Language.SQL.SimpleSQL.ScalarExprs+> import Language.SQL.SimpleSQL.Odbc > import Language.SQL.SimpleSQL.Tpch+> import Language.SQL.SimpleSQL.LexerTests -> import Language.SQL.SimpleSQL.SQL2011+> 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  Order the tests to start from the simplest first. This is also the order on the generated documentation.@@ -38,7 +45,9 @@ > testData :: TestItem > testData = >     Group "parserTest"->     [valueExprTests+>     [lexerTests+>     ,scalarExprTests+>     ,odbcTests >     ,queryExprComponentTests >     ,queryExprsTests >     ,tableRefTests@@ -46,43 +55,66 @@ >     ,fullQueriesTests >     ,postgresTests >     ,tpchTests->     ,sql2011Tests+>     ,sql2011QueryTests+>     ,sql2011DataManipulationTests+>     ,sql2011SchemaTests+>     ,sql2011AccessControlTests+>     ,sql2011BitsTests >     ,mySQLTests+>     ,oracleTests >     ] -> tests :: Test.Framework.Test+> tests :: T.TestTree > tests = itemToTest testData  > --runTests :: IO () > --runTests = void $ H.runTestTT $ itemToTest testData -> itemToTest :: TestItem -> Test.Framework.Test+> itemToTest :: TestItem -> T.TestTree > itemToTest (Group nm ts) =->     testGroup nm $ map itemToTest ts-> itemToTest (TestValueExpr d str expected) =->     toTest parseValueExpr prettyValueExpr d str expected+>     T.testGroup nm $ map itemToTest ts+> itemToTest (TestScalarExpr d str expected) =+>     toTest parseScalarExpr prettyScalarExpr d str expected > itemToTest (TestQueryExpr d str expected) = >     toTest parseQueryExpr prettyQueryExpr d str expected-> itemToTest (TestQueryExprs d str expected) =->     toTest parseQueryExprs prettyQueryExprs d str expected+> itemToTest (TestStatement d str expected) =+>     toTest parseStatement prettyStatement d str expected+> itemToTest (TestStatements d str expected) =+>     toTest parseStatements prettyStatements d str expected > itemToTest (ParseQueryExpr d str) = >     toPTest parseQueryExpr prettyQueryExpr d str  > itemToTest (ParseQueryExprFails d str) = >     toFTest parseQueryExpr prettyQueryExpr d str -> itemToTest (ParseValueExprFails d str) =->     toFTest parseValueExpr prettyValueExpr d str+> itemToTest (ParseScalarExprFails d str) =+>     toFTest parseScalarExpr prettyScalarExpr d str +> itemToTest (LexTest d s ts) = makeLexerTest d s ts+> itemToTest (LexFails d s) = makeLexingFailsTest d s +> makeLexerTest :: Dialect -> String -> [Token] -> T.TestTree+> makeLexerTest d s ts = H.testCase s $ do+>     let lx = either (error . show) id $ lexSQL d "" Nothing s+>     H.assertEqual "" ts $ map snd lx+>     let s' = prettyTokens d $ map snd lx+>     H.assertEqual "pretty print" s s'++> makeLexingFailsTest :: Dialect -> String -> T.TestTree+> makeLexingFailsTest d s = H.testCase s $ do+>     case lexSQL d "" Nothing s of+>          Right x -> H.assertFailure $ "lexing should have failed: " ++ s ++ "\ngot: " ++ show x+>          Left _ -> return ()++ > toTest :: (Eq a, Show a) => >           (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a) >        -> (Dialect -> a -> String) >        -> Dialect >        -> String >        -> a->        -> Test.Framework.Test-> toTest parser pp d str expected = testCase str $ do+>        -> T.TestTree+> toTest parser pp d str expected = H.testCase str $ do >         let egot = parser d "" Nothing str >         case egot of >             Left e -> H.assertFailure $ peFormattedError e@@ -103,8 +135,8 @@ >        -> (Dialect -> a -> String) >        -> Dialect >        -> String->        -> Test.Framework.Test-> toPTest parser pp d str = testCase str $ do+>        -> T.TestTree+> toPTest parser pp d str = H.testCase str $ do >         let egot = parser d "" Nothing str >         case egot of >             Left e -> H.assertFailure $ peFormattedError e@@ -123,10 +155,10 @@ >        -> (Dialect -> a -> String) >        -> Dialect >        -> String->        -> Test.Framework.Test-> toFTest parser pp d str = testCase str $ do+>        -> T.TestTree+> toFTest parser _pp d str = H.testCase str $ do >         let egot = parser d "" Nothing str >         case egot of->             Left e -> return ()->             Right got ->+>             Left _e -> return ()+>             Right _got -> >               H.assertFailure $ "parse didn't fail: " ++ show d ++ "\n" ++ str
tools/Language/SQL/SimpleSQL/Tpch.lhs view
@@ -13,7 +13,7 @@ > tpchTests :: TestItem > tpchTests = >     Group "parse tpch"->     $ map (ParseQueryExpr SQL2011 . snd) tpchQueries+>     $ map (ParseQueryExpr ansi2011 . snd) tpchQueries  > tpchQueries :: [(String,String)] > tpchQueries =
− 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 view
@@ -1,8 +1,8 @@  -> import Test.Framework+> import Test.Tasty  > import Language.SQL.SimpleSQL.Tests  > main :: IO ()-> main = defaultMain [tests]+> 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"
+ tools/SimpleSqlParserTool.lhs view
@@ -0,0 +1,96 @@++Simple command line tool to experiment with simple-sql-parser++Commands:++parse: parse sql from file, stdin or from command line+lex: lex sql same+indent: parse then pretty print sql++> {-# LANGUAGE TupleSections #-}+> import System.Environment+> import Control.Monad+> import Data.Maybe+> import System.Exit+> import Data.List+> import Text.Show.Pretty+> import Control.Applicative++> import Language.SQL.SimpleSQL.Pretty+> import Language.SQL.SimpleSQL.Parse+> import Language.SQL.SimpleSQL.Syntax+> import Language.SQL.SimpleSQL.Lex+++> dialect = ansi2011++> main :: IO ()+> main = do+>     args <- getArgs+>     case args of+>         [] -> do+>               showHelp $ Just "no command given"+>         (c:as) -> do+>              let cmd = lookup c commands+>              maybe (showHelp (Just "command not recognised"))+>                    (\(_,cmd') -> cmd' as)+>                    cmd++> commands :: [(String, (String,[String] -> IO ()))]+> commands =+>     [("help", helpCommand)+>     ,("parse", parseCommand)+>     ,("lex", lexCommand)+>     ,("indent", indentCommand)]++> showHelp :: Maybe String -> IO ()+> showHelp msg = do+>           maybe (return ()) (\e -> putStrLn $ "Error: " ++ e) msg+>           putStrLn "Usage:\n SimpleSqlParserTool command args"+>           forM_ commands $ \(c, (h,_)) -> do+>                putStrLn $ c ++ "\t" ++ h+>           when (isJust msg) $ exitFailure++> helpCommand :: (String,[String] -> IO ())+> helpCommand =+>     ("show help for this progam", \_ -> showHelp Nothing)++> getInput :: [String] -> IO (FilePath,String)+> getInput as =+>     case as of+>       ["-"] -> ("-",) <$> getContents+>       ("-c":as') -> return ("-", unwords as')+>       [filename] -> (filename,) <$> readFile filename+>       _ -> showHelp (Just "arguments not recognised") >> error ""++> parseCommand :: (String,[String] -> IO ())+> parseCommand =+>   ("parse SQL from file/stdin/command line (use -c to parse from command line)"+>   ,\args -> do+>       (f,src) <- getInput args+>       either (error . peFormattedError)+>           (putStrLn . ppShow)+>           $ parseStatements dialect f Nothing src+>   )++> lexCommand :: (String,[String] -> IO ())+> lexCommand =+>   ("lex SQL from file/stdin/command line (use -c to parse from command line)"+>   ,\args -> do+>       (f,src) <- getInput args+>       either (error . peFormattedError)+>              (putStrLn . intercalate ",\n" . map show)+>              $ lexSQL dialect f Nothing src+>   )+++> indentCommand :: (String,[String] -> IO ())+> indentCommand =+>   ("parse then pretty print SQL from file/stdin/command line (use -c to parse from command line)"+>   ,\args -> do+>       (f,src) <- getInput args+>       either (error . peFormattedError)+>           (putStrLn . prettyStatements dialect)+>           $ parseStatements dialect f Nothing src++>   )