packages feed

simple-sql-parser 0.3.1 → 0.4.0

raw patch · 17 files changed

+7276/−1361 lines, 17 filesdep −haskell-src-extsdep ~basedep ~mtl

Dependencies removed: haskell-src-exts

Dependency ranges changed: base, mtl

Files

+ Language/SQL/SimpleSQL/Combinators.lhs view
@@ -0,0 +1,107 @@++> -- | This module contains some generic combinators used in the+> -- parser. None of the parsing which relies on the local lexers is+> -- in this module. Some of these combinators have been taken from+> -- other parser combinator libraries other than Parsec.++> module Language.SQL.SimpleSQL.Combinators+>     (optionSuffix+>     ,(<??>)+>     ,(<??.>)+>     ,(<??*>)+>     ,(<$$>)+>     ,(<$$$>)+>     ,(<$$$$>)+>     ,(<$$$$$>)+>     ) where++> import Control.Applicative ((<$>), (<*>), (<**>), pure, Applicative)+> import Text.Parsec (option,many)+> import Text.Parsec.String (Parser)++a possible issue with the option suffix is that it enforces left+associativity when chaining it recursively. Have to review+all these uses and figure out if any should be right associative+instead, and create an alternative suffix parser++This function style is not good, and should be replaced with chain and+<??> which has a different type++> optionSuffix :: (a -> Parser a) -> a -> Parser a+> optionSuffix p a = option a (p a)+++parses an optional postfix element and applies its result to its left+hand result, taken from uu-parsinglib++TODO: make sure the precedence higher than <|> and lower than the+other operators so it can be used nicely++> (<??>) :: Parser a -> Parser (a -> a) -> Parser a+> p <??> q = p <**> option id q+++Help with left factored parsers. <$$> is like an analogy with <**>:++f <$> a <*> b++is like++a <**> (b <$$> f)++f <$> a <*> b <*> c++is like++a <**> (b <**> (c <$$$> f))++> (<$$>) :: Applicative f =>+>       f b -> (a -> b -> c) -> f (a -> c)+> (<$$>) pa c = pa <**> pure (flip c)++> (<$$$>) :: Applicative f =>+>           f c -> (a -> b -> c -> t) -> f (b -> a -> t)+> p <$$$> c = p <**> pure (flip3 c)++> (<$$$$>) :: Applicative f =>+>           f d -> (a -> b -> c -> d -> t) -> f (c -> b -> a -> t)+> p <$$$$> c = p <**> pure (flip4 c)++> (<$$$$$>) :: Applicative f =>+>           f e -> (a -> b -> c -> d -> e -> t) -> f (d -> c -> b -> a -> t)+> p <$$$$$> c = p <**> pure (flip5 c)++Surely no-one would write code like this seriously?+++composing suffix parsers, not sure about the name. This is used to add+a second or more suffix parser contingent on the first suffix parser+succeeding.++> (<??.>) :: Parser (a -> a) -> Parser (a -> a) -> Parser (a -> a)+> (<??.>) pa pb = (.) `c` pa <*> option id pb+>   -- todo: fix this mess+>   where c = (<$>) . flip+++0 to many repeated applications of suffix parser++> (<??*>) :: Parser a -> Parser (a -> a) -> Parser a+> p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)+++These are to help with left factored parsers:++a <**> (b <**> (c <**> pure (flip3 ctor)))++Not sure the names are correct, but they follow a pattern with flip+a <**> (b <**> pure (flip ctor))++> flip3 :: (a -> b -> c -> t) -> c -> b -> a -> t+> flip3 f a b c = f c b a++> flip4 :: (a -> b -> c -> d -> t) -> d -> c -> b -> a -> t+> flip4 f a b c d = f d c b a++> flip5 :: (a -> b -> c -> d -> e -> t) -> e -> d -> c -> b -> a -> t+> flip5 f a b c d e = f e d c b a
+ Language/SQL/SimpleSQL/Errors.lhs view
@@ -0,0 +1,51 @@++> -- | helpers to work with parsec errors more nicely+> module Language.SQL.SimpleSQL.Errors+>     (ParseError(..)+>     --,formatError+>     ,convParseError+>     ) where++> import Text.Parsec (sourceColumn,sourceLine,sourceName,errorPos)+> import qualified Text.Parsec as P (ParseError)++> -- | Type to represent parse errors.+> data ParseError = ParseError+>                   {peErrorString :: String+>                    -- ^ contains the error message+>                   ,peFilename :: FilePath+>                    -- ^ filename location for the error+>                   ,pePosition :: (Int,Int)+>                    -- ^ line number and column number location for the error+>                   ,peFormattedError :: String+>                    -- ^ formatted error with the position, error+>                    -- message and source context+>                   } deriving (Eq,Show)++> convParseError :: String -> P.ParseError -> ParseError+> convParseError src e =+>     ParseError+>     {peErrorString = show e+>     ,peFilename = sourceName p+>     ,pePosition = (sourceLine p, sourceColumn p)+>     ,peFormattedError = formatError src e}+>   where+>     p = errorPos e++format the error more nicely: emacs format for positioning, plus+context++> formatError :: String -> P.ParseError -> String+> formatError src e =+>     sourceName p ++ ":" ++ show (sourceLine p)+>     ++ ":" ++ show (sourceColumn p) ++ ":"+>     ++ context+>     ++ show e+>   where+>     context =+>         let lns = take 1 $ drop (sourceLine p - 1) $ lines src+>         in case lns of+>              [x] -> "\n" ++ x ++ "\n"+>                     ++ replicate (sourceColumn p - 1) ' ' ++ "^\n"+>              _ -> ""+>     p = errorPos e
Language/SQL/SimpleSQL/Parser.lhs view
@@ -1,966 +1,1974 @@ -> {-# 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)-> import Control.Applicative ((<$), (<$>), (<*>) ,(<*), (*>))-> import Data.Maybe (fromMaybe,catMaybes)-> import Data.Char (toLower)-> import Text.Parsec (errorPos,sourceLine,sourceColumn,sourceName->                    ,setPosition,setSourceColumn,setSourceLine,getPosition->                    ,option,between,sepBy,sepBy1,string,manyTill,anyChar->                    ,try,string,many1,oneOf,digit,(<|>),choice,char,eof->                    ,optionMaybe,optional,many,letter,alphaNum,parse)-> import Text.Parsec.String (Parser)-> import qualified Text.Parsec as P (ParseError)-> import Text.Parsec.Perm (permute,(<$?>), (<|?>))-> import qualified Text.Parsec.Expr as E--> import Language.SQL.SimpleSQL.Syntax--The public API functions.--> -- | Parses a query expr, trailing semicolon optional.-> parseQueryExpr :: FilePath->                   -- ^ filename to use in errors->                -> Maybe (Int,Int)->                   -- ^ line number and column number of the first character->                   -- in the source (to use in errors)->                -> 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 :: FilePath->                    -- ^ filename to use in errors->                 -> Maybe (Int,Int)->                    -- ^ line number and column number of the first character->                    -- in the source (to use in errors)->                 -> String->                    -- ^ the SQL source to parse->                 -> Either ParseError [QueryExpr]-> parseQueryExprs = wrapParse queryExprs--> -- | Parses a value expression.-> parseValueExpr :: FilePath->                    -- ^ filename to use in errors->                 -> Maybe (Int,Int)->                    -- ^ line number and column number of the first character->                    -- in the source (to use in errors)->                 -> 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->           -> FilePath->           -> Maybe (Int,Int)->           -> String->           -> Either ParseError a-> wrapParse parser f p src =->     either (Left . convParseError src) Right->     $ parse (setPos p *> whiteSpace *> parser <* eof) f src--> -- | Type to represent parse errors.-> data ParseError = ParseError->                   {peErrorString :: String->                    -- ^ contains the error message->                   ,peFilename :: FilePath->                    -- ^ filename location for the error->                   ,pePosition :: (Int,Int)->                    -- ^ line number and column number location for the error->                   ,peFormattedError :: String->                    -- ^ formatted error with the position, error->                    -- message and source context->                   } deriving (Eq,Show)----------------------------------------------------= value expressions--== literals--See the stringLiteral lexer below for notes on string literal syntax.--> estring :: Parser ValueExpr-> estring = StringLit <$> stringLiteral--> number :: Parser ValueExpr-> number = NumLit <$> numberLiteral--parse SQL interval literals, something like-interval '5' day (3)-or-interval '5' month--wrap the whole lot in try, in case we get something like this:-interval '3 days'-which parses as a typed literal--> interval :: Parser ValueExpr-> interval = try (keyword_ "interval" >>->     IntervalLit->     <$> stringLiteral->     <*> identifierString->     <*> optionMaybe (try $ parens integerLiteral))--> literal :: Parser ValueExpr-> literal = number <|> estring <|> interval--== identifiers--Uses the identifierString 'lexer'. See this function for notes on-identifiers.--> name :: Parser Name-> name = choice [QName <$> quotedIdentifier->               ,Name <$> identifierString]--> identifier :: Parser ValueExpr-> identifier = Iden <$> name--== star--used in select *, select x.*, and agg(*) variations, and some other-places as well. Because it is quite general, 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--use in e.g. select * from t where a = ?--> parameter :: Parser ValueExpr-> parameter = Parameter <$ symbol "?"--== function application, aggregates and windows--this represents anything which syntactically looks like regular C-function application: an identifier, parens with comma sep value-expression arguments.--The parsing for the aggregate extensions is here as well:--aggregate([all|distinct] args [order by orderitems])--> aggOrApp :: Parser ValueExpr-> aggOrApp =->     makeApp->     <$> name->     <*> parens ((,,) <$> try duplicates->                      <*> choice [commaSep valueExpr]->                      <*> try (optionMaybe orderBy))->   where->     makeApp i (Nothing,es,Nothing) = App i es->     makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od)--> duplicates :: Parser (Maybe SetQuantifier)-> duplicates = optionMaybe $ try $->     choice [All <$ keyword_ "all"->            ,Distinct <$ keyword "distinct"]--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.--The convention in this file is that the 'Suffix', erm, suffix on-parser names means that they have been left factored. These are almost-always used with the optionSuffix combinator.--> windowSuffix :: ValueExpr -> Parser ValueExpr-> windowSuffix (App f es) =->     try (keyword_ "over")->     *> parens (WindowApp f es->                <$> option [] partitionBy->                <*> option [] orderBy->                <*> optionMaybe frameClause)->   where->     partitionBy = try (keyword_ "partition") >>->         keyword_ "by" >> commaSep1 valueExpr->     frameClause =->         mkFrame <$> choice [FrameRows <$ keyword_ "rows"->                            ,FrameRange <$ keyword_ "range"]->                 <*> frameStartEnd->     frameStartEnd =->         choice->         [try (keyword_ "between") >>->          mkFrameBetween <$> frameLimit True->                         <*> (keyword_ "and" *> frameLimit True)->         ,mkFrameFrom <$> frameLimit False]->     -- use the bexpression style from the between parsing for frame between->     frameLimit useB =->         choice->         [Current <$ try (keyword_ "current") <* keyword_ "row"->         ,try (keyword_ "unbounded") >>->          choice [UnboundedPreceding <$ keyword_ "preceding"->                 ,UnboundedFollowing <$ keyword_ "following"]->         ,do->          e <- if useB then valueExprB else valueExpr->          choice [Preceding e <$ keyword_ "preceding"->                 ,Following e <$ keyword_ "following"]->         ]->     mkFrameBetween s e rs = FrameBetween rs s e->     mkFrameFrom s rs = FrameFrom rs s->     mkFrame rs c = c rs-> windowSuffix _ = fail ""--> app :: Parser ValueExpr-> app = aggOrApp >>= optionSuffix windowSuffix--== case expression--> scase :: Parser ValueExpr-> scase =->     Case <$> (try (keyword_ "case") *> optionMaybe (try valueExpr))->          <*> many1 swhen->          <*> optionMaybe (try (keyword_ "else") *> valueExpr)->          <* keyword_ "end"->   where->     swhen = keyword_ "when" *>->             ((,) <$> commaSep1 valueExpr->                  <*> (keyword_ "then" *> valueExpr))--== miscellaneous keyword operators--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.--cast: cast(expr as type)--> cast :: Parser ValueExpr-> cast = parensCast <|> prefixCast->   where->     parensCast = try (keyword_ "cast") >>->                  parens (Cast <$> valueExpr->                          <*> (keyword_ "as" *> typeName))->     prefixCast = try (TypedLit <$> typeName->                              <*> stringLiteral)--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 $ symbol  "("->     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)->               return e->     fa <- case firstArg of->          SOKNone -> return Nothing->          SOKOptional -> optionMaybe (try pfa)->          SOKMandatory -> Just <$> pfa->     as <- mapM parseArg kws->     void $ symbol ")"->     return $ 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),("collate", 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 " " stringLiteral->             <*> (keyword_ "from" *> valueExpr)->             <*> optionMaybe (keyword_ "collate" *> stringLiteral))->   where->     sides = choice ["leading" <$ keyword_ "leading"->                    ,"trailing" <$ keyword_ "trailing"->                    ,"both" <$ keyword_ "both"]->     mkTrim fa ch fr cl =->       SpecialOpK (Name "trim") Nothing->           $ catMaybes [Just (fa,StringLit ch)->                       ,Just ("from", fr)->                       ,fmap (("collate",) . StringLit) cl]--in: two variations:-a in (expr0, expr1, ...)-a in (queryexpr)--this is parsed as a postfix operator which is why it is in this form--> inSuffix :: Parser (ValueExpr -> ValueExpr)-> inSuffix =->     mkIn <$> inty->          <*> parens (choice->                      [InQueryExpr <$> queryExpr->                      ,InList <$> commaSep1 valueExpr])->   where->     inty = try $ choice [True <$ keyword_ "in"->                         ,False <$ keyword_ "not" <* keyword_ "in"]->     mkIn i v = \e -> In i e v---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 = try $ choice->              ["between" <$ keyword_ "between"->              ,"not between" <$ keyword_ "not" <* keyword_ "between"]->     makeOp n b c = \a -> SpecialOp n [a,b,c]--subquery expression:-[exists|all|any|some] (queryexpr)--> subquery :: Parser ValueExpr-> subquery =->     choice->     [try $ SubQueryExpr SqSq <$> parens queryExpr->     ,SubQueryExpr <$> try sqkw <*> parens queryExpr]->   where->     sqkw = try $ choice->            [SqExists <$ keyword_ "exists"->            ,SqAll <$ try (keyword_ "all")->            ,SqAny <$ keyword_ "any"->            ,SqSome <$ keyword_ "some"]--typename: used in casts. Special cases for the multi keyword typenames-that SQL supports.--> typeName :: Parser TypeName-> typeName = choice (multiWordParsers->                    ++ [TypeName <$> identifierString])->            >>= optionSuffix precision->   where->     multiWordParsers =->         flip map multiWordTypeNames->         $ \ks -> (TypeName . unwords) <$> try (mapM keyword ks)->     multiWordTypeNames = map words->         ["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"->         ]--todo: timestamp types:--    | TIME [ <left paren> <time precision> <right paren> ] [ WITH TIME ZONE ]-     | TIMESTAMParser [ <left paren> <timestamp precision> <right paren> ] [ WITH TIME ZONE ]--->     precision t = try (parens (commaSep integerLiteral)) >>= makeWrap t->     makeWrap (TypeName t) [a] = return $ PrecTypeName t a->     makeWrap (TypeName t) [a,b] = return $ PrecScaleTypeName t a b->     makeWrap _ _ = fail "there must be one or two precision components"---== value expression parens and row ctor--> sparens :: Parser ValueExpr-> sparens =->     ctor <$> parens (commaSep1 valueExpr)->   where->     ctor [a] = Parens a->     ctor as = SpecialOp (Name "rowctor") as---== operator parsing--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.--> opTable :: Bool -> [[E.Operator String () Identity ValueExpr]]-> opTable bExpr =->         [[binarySym "." E.AssocLeft]->         ,[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]->          ++ map (`binaryKeywords` E.AssocNone)->          ["not like"->          ,"is similar to"->          ,"is not similar to"->          ,"is distinct from"->          ,"is not distinct from"]->          ++ map postfixKeywords->          ["is null"->          ,"is not null"->          ,"is true"->          ,"is not true"->          ,"is false"->          ,"is not false"->          ,"is unknown"->          ,"is not unknown"]->           ++ [E.Postfix $ try inSuffix,E.Postfix $ try 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 (try $ symbol_ nm) nm assoc->     binaryKeyword nm assoc = binary (try $ keyword_ nm) nm assoc->     binaryKeywords nm assoc = binary (try $ mapM_ keyword_ (words nm)) nm assoc->     binary p nm assoc =->       E.Infix (p >> return (\a b -> BinOp a (Name nm) b)) assoc->     prefixKeyword nm = prefix (try $ keyword_ nm) nm->     prefixSym nm = prefix (try $ symbol_ nm) nm->     prefix p nm = E.Prefix (p >> return (PrefixOp (Name nm)))->     postfixKeywords nm = postfix (try $ mapM_ keyword_ (words nm)) nm->     postfix p nm = E.Postfix (p >> return (PostfixOp (Name nm)))--== value expressions--TODO:-left factor stuff which starts with identifier--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.--> valueExpr :: Parser ValueExpr-> valueExpr = E.buildExpressionParser (opTable False) term--> term :: Parser ValueExpr-> term = choice [literal->               ,parameter->               ,scase->               ,cast->               ,try specialOpKs->               ,subquery->               ,try app->               ,try star->               ,identifier->               ,sparens]--expose the b expression for window frame clause range between--> valueExprB :: Parser ValueExpr-> valueExprB = E.buildExpressionParser (opTable True) term------------------------------------------------------= query expressions--== select lists--> selectItem :: Parser (ValueExpr,Maybe Name)-> selectItem = (,) <$> valueExpr <*> optionMaybe (try als)->   where als = optional (try (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 (...)]--> from :: Parser [TableRef]-> from = try (keyword_ "from") *> commaSep1 tref->   where->     tref = nonJoinTref >>= optionSuffix joinTrefSuffix->     nonJoinTref = choice [try (TRQueryExpr <$> parens queryExpr)->                          ,TRParens <$> parens tref->                          ,TRLateral <$> (try (keyword_ "lateral")->                                          *> nonJoinTref)->                          ,try (TRFunction <$> name->                                           <*> parens (commaSep valueExpr))->                          ,TRSimple <$> name]->                   >>= optionSuffix aliasSuffix->     aliasSuffix j = option j (TRAlias j <$> alias)->     joinTrefSuffix t = (do->          nat <- option False $ try (True <$ try (keyword_ "natural"))->          TRJoin t <$> joinType->                   <*> nonJoinTref->                   <*> optionMaybe (joinCondition nat))->         >>= optionSuffix joinTrefSuffix->     joinType =->         choice [choice->                 [JCross <$ try (keyword_ "cross")->                 ,JInner <$ try (keyword_ "inner")->                 ,choice [JLeft <$ try (keyword_ "left")->                         ,JRight <$ try (keyword_ "right")->                         ,JFull <$ try (keyword_ "full")]->                  <* optional (try $ keyword_ "outer")]->                 <* keyword "join"->                ,JInner <$ keyword_ "join"]->     joinCondition nat =->         choice [guard nat >> return JoinNatural->                ,try (keyword_ "on") >>->                 JoinOn <$> valueExpr->                ,try (keyword_ "using") >>->                 JoinUsing <$> parens (commaSep1 name)->                ]--> alias :: Parser Alias-> alias = Alias <$> try tableAlias <*> try columnAliases->   where->     tableAlias = optional (try $ keyword_ "as") *> name->     columnAliases = optionMaybe $ try $ parens $ commaSep1 name--== simple other parts--Parsers for where, group by, having, order by and limit, which are-pretty trivial.--Here is a helper for parsing a few parts of the query expr (currently-where, having, limit, offset).--> keywordValueExpr :: String -> Parser ValueExpr-> keywordValueExpr k = try (keyword_ k) *> valueExpr--> swhere :: Parser ValueExpr-> swhere = keywordValueExpr "where"--> sgroupBy :: Parser [GroupingExpr]-> sgroupBy = try (keyword_ "group")->            *> keyword_ "by"->            *> commaSep1 groupingExpression->   where->     groupingExpression =->       choice->       [try (keyword_ "cube") >>->        Cube <$> parens (commaSep groupingExpression)->       ,try (keyword_ "rollup") >>->        Rollup <$> parens (commaSep groupingExpression)->       ,GroupingParens <$> parens (commaSep groupingExpression)->       ,try (keyword_ "grouping") >> keyword_ "sets" >>->        GroupingSets <$> parens (commaSep groupingExpression)->       ,SimpleGroup <$> valueExpr->       ]--> having :: Parser ValueExpr-> having = keywordValueExpr "having"--> orderBy :: Parser [SortSpec]-> orderBy = try (keyword_ "order") *> keyword_ "by" *> commaSep1 ob->   where->     ob = SortSpec->          <$> valueExpr->          <*> option Asc (choice [Asc <$ keyword_ "asc"->                                 ,Desc <$ keyword_ "desc"])->          <*> option NullsOrderDefault->              (try (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 = try (keyword_ "offset") *> valueExpr->          <* option () (try $ choice [try (keyword_ "rows"),keyword_ "row"])--> fetch :: Parser ValueExpr-> fetch = choice [ansiFetch, limit]->   where->     ansiFetch = try (keyword_ "fetch") >>->         choice [keyword_ "first",keyword_ "next"]->         *> valueExpr->         <* choice [keyword_ "rows",keyword_ "row"]->         <* keyword_ "only"->     limit = try (keyword_ "limit") *> valueExpr--== common table expressions--> with :: Parser QueryExpr-> with = try (keyword_ "with") >>->     With <$> option False (try (True <$ keyword_ "recursive"))->          <*> commaSep1 withQuery <*> queryExpr->   where->     withQuery =->         (,) <$> (alias <* optional (try $ 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->          ,choice [values,table, select]->           >>= optionSuffix queryExprSuffix]->   where->     select = try (keyword_ "select") >>->         mkSelect->         <$> (fromMaybe All <$> duplicates)->         <*> selectList->         <*> option [] from->         <*> optionMaybe swhere->         <*> option [] sgroupBy->         <*> optionMaybe having->         <*> option [] orderBy->         <*> offsetFetch->     mkSelect d sl f w g h od (ofs,fe) =->         Select d sl f w g h od ofs fe->     values = try (keyword_ "values")->              >> Values <$> commaSep (parens (commaSep valueExpr))->     table = try (keyword_ "table") >> Table <$> name--> queryExprSuffix :: QueryExpr -> Parser QueryExpr-> queryExprSuffix qe =->     (CombineQueryExpr qe->      <$> try (choice->               [Union <$ keyword_ "union"->               ,Intersect <$ keyword_ "intersect"->               ,Except <$ keyword_ "except"])->      <*> (fromMaybe All <$> duplicates)->      <*> option Respectively->                 (try (Corresponding <$ keyword_ "corresponding"))->      <*> queryExpr)->     >>= optionSuffix queryExprSuffix--wrapper for query expr which ignores optional trailing semicolon.--> topLevelQueryExpr :: Parser QueryExpr-> topLevelQueryExpr =->      queryExpr >>= optionSuffix ((symbol ";" *>) . return)--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.--> queryExprs :: Parser [QueryExpr]-> queryExprs =->     (:[]) <$> queryExpr->     >>= optionSuffix ((symbol ";" *>) . return)->     >>= optionSuffix (\p -> (p++) <$> queryExprs)----------------------------------------------------= lexing parsers--The lexing is a bit 'virtual', in the usual parsec style. The-convention in this file is to put all the parsers which access-characters directly or indirectly here (i.e. ones which use char,-string, digit, etc.), except for the parsers which only indirectly-access them via these functions, if you follow?--> symbol :: String -> Parser String-> symbol s = string s->            -- <* notFollowedBy (oneOf "+-/*<>=!|")->            <* whiteSpace--> symbol_ :: String -> Parser ()-> symbol_ s = symbol s *> return ()--TODO: now that keyword has try in it, a lot of the trys above can be-removed--> keyword :: String -> Parser String-> keyword s = try $ do->     i <- identifierRaw->     guard (map toLower i == map toLower s)->     return i--> keyword_ :: String -> Parser ()-> keyword_ s = keyword s *> return ()--Identifiers are very simple at the moment: start with a letter or-underscore, and continue with letter, underscore or digit. It doesn't-support quoting other other sorts of identifiers yet. There is a-blacklist of keywords which aren't supported as identifiers.--the identifier raw doesn't check the blacklist since it is used by the-keyword parser also--> identifierRaw :: Parser String-> identifierRaw = (:) <$> letterOrUnderscore->                     <*> many letterDigitOrUnderscore <* whiteSpace->   where->     letterOrUnderscore = char '_' <|> letter->     letterDigitOrUnderscore = char '_' <|> alphaNum--> identifierString :: Parser String-> identifierString = do->     s <- identifierRaw->     guard (map toLower s `notElem` blacklist)->     return s--> blacklist :: [String]-> blacklist =->     ["select", "as", "from", "where", "having", "group", "order"->     ,"limit", "offset", "fetch"->     ,"inner", "left", "right", "full", "natural", "join"->     ,"cross", "on", "using", "lateral"->     ,"when", "then", "case", "end", "in"->     ,"except", "intersect", "union"]--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.--> quotedIdentifier :: Parser String-> quotedIdentifier = char '"' *> manyTill anyChar (symbol_ "\"")---String literals: limited at the moment, no escaping \' or other-variations.--> stringLiteral :: Parser String-> stringLiteral = (char '\'' *> manyTill anyChar (char '\'')->                  >>= optionSuffix moreString) <* whiteSpace->   where->     moreString s0 = try $ do->         void $ char '\''->         s <- manyTill anyChar (char '\'')->         optionSuffix moreString (s0 ++ "'" ++ s)--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 =->     choice [int->             >>= optionSuffix dot->             >>= optionSuffix fracts->             >>= optionSuffix expon->            ,fract "" >>= optionSuffix expon]->     <* whiteSpace->   where->     int = many1 digit->     fract p = dot p >>= fracts->     dot p = (p++) <$> string "."->     fracts p = (p++) <$> int->     expon p = concat <$> sequence->               [return p->               ,string "e"->               ,option "" (string "+" <|> string "-")->               ,int]--lexer for integer literals which appear in some places in SQL--> integerLiteral :: Parser Int-> integerLiteral = read <$> many1 digit <* whiteSpace--whitespace parser which skips comments also--> whiteSpace :: Parser ()-> whiteSpace =->     choice [simpleWhiteSpace *> whiteSpace->            ,lineComment *> whiteSpace->            ,blockComment *> whiteSpace->            ,return ()]->   where->     lineComment = try (string "--")->                   *> manyTill anyChar (void (char '\n') <|> eof)->     blockComment = -- no nesting of block comments in SQL->                    try (string "/*")->                    -- TODO: why is try used herex->                    *> manyTill anyChar (try $ string "*/")->     -- use many1 so we can more easily avoid non terminating loops->     simpleWhiteSpace = void $ many1 (oneOf " \t\n")--= generic parser helpers--a possible issue with the option suffix is that it enforces left-associativity when chaining it recursively. Have to review-all these uses and figure out if any should be right associative-instead, and create an alternative suffix parser--> optionSuffix :: (a -> Parser a) -> a -> Parser a-> optionSuffix p a = option a (p a)--> parens :: Parser a -> Parser a-> parens = between (symbol_ "(") (symbol_ ")")--> commaSep :: Parser a -> Parser [a]-> commaSep = (`sepBy` symbol_ ",")---> commaSep1 :: Parser a -> Parser [a]-> commaSep1 = (`sepBy1` symbol_ ",")------------------------------------------------= helper functions--> setPos :: Maybe (Int,Int) -> Parser ()-> setPos Nothing = return ()-> setPos (Just (l,c)) = fmap f getPosition >>= setPosition->   where f = flip setSourceColumn c->             . flip setSourceLine l--> convParseError :: String -> P.ParseError -> ParseError-> convParseError src e =->     ParseError->     {peErrorString = show e->     ,peFilename = sourceName p->     ,pePosition = (sourceLine p, sourceColumn p)->     ,peFormattedError = formatError src e->     }->   where->     p = errorPos e--format the error more nicely: emacs format for positioning, plus-context--> formatError :: String -> P.ParseError -> String-> formatError src e =->     sourceName p ++ ":" ++ show (sourceLine p)->     ++ ":" ++ show (sourceColumn p) ++ ":"->     ++ context->     ++ show e->   where->     context =->         let lns = take 1 $ drop (sourceLine p - 1) $ lines src->         in case lns of->              [x] -> "\n" ++ x ++ "\n"->                     ++ replicate (sourceColumn p - 1) ' ' ++ "^\n"->              _ -> ""->     p = errorPos e+= 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,parse+>                    ,chainl1, chainr1,(<?>) {-,notFollowedBy,alphaNum-}, lookAhead)+> import Text.Parsec.String (Parser)+> import Text.Parsec.Perm (permute,(<$?>), (<|?>))+> 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 :: FilePath+>                   -- ^ filename to use in errors+>                -> Maybe (Int,Int)+>                   -- ^ line number and column number of the first character+>                   -- in the source (to use in errors)+>                -> 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 :: FilePath+>                    -- ^ filename to use in errors+>                 -> Maybe (Int,Int)+>                    -- ^ line number and column number of the first character+>                    -- in the source (to use in errors)+>                 -> String+>                    -- ^ the SQL source to parse+>                 -> Either ParseError [QueryExpr]+> parseQueryExprs = wrapParse queryExprs++> -- | Parses a value expression.+> parseValueExpr :: FilePath+>                    -- ^ filename to use in errors+>                 -> Maybe (Int,Int)+>                    -- ^ line number and column number of the first character+>                    -- in the source (to use in errors)+>                 -> 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+>           -> FilePath+>           -> Maybe (Int,Int)+>           -> String+>           -> Either ParseError a+> wrapParse parser f p src =+>     either (Left . convParseError src) Right+>     $ parse (setPos p *> whitespace *> parser <* eof) 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 = choice [QName <$> quotedIdentifier+>               ,UQName <$> uquotedIdentifier+>               ,Name <$> identifierBlacklist blacklist]++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 () 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 (...)]++> 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 = fs *> valueExpr <* ro+>   where+>     fs = makeKeywordTree ["fetch first", "fetch next"]+>     ro = makeKeywordTree ["rows only", "row only"]++== 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 :: [String]+> blacklist = reservedWord {-+>     [-- case+>      "case", "when", "then", "else", "end"+>     ,--join+>      "natural","inner","outer","cross","left","right","full","join"+>     ,"on","using","lateral"+>     ,"from","where","group","having","order","limit", "offset", "fetch"+>     ,"as","in"+>     ,"except", "intersect", "union"+>     ] -}++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 :: [String]+> reservedWord =+>     ["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"+>     ]
Language/SQL/SimpleSQL/Pretty.lhs view
@@ -14,8 +14,9 @@ > import Language.SQL.SimpleSQL.Syntax > import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens, >                          nest, Doc, punctuate, comma, sep, quotes,->                          doubleQuotes)+>                          doubleQuotes, brackets,hcat) > import Data.Maybe (maybeToList, catMaybes)+> import Data.List (intercalate)  > -- | Convert a query expr ast to concrete syntax. > prettyQueryExpr :: QueryExpr -> String@@ -34,39 +35,50 @@  > valueExpr :: ValueExpr -> Doc > valueExpr (StringLit s) = quotes $ text $ doubleUpQuotes s->   where doubleUpQuotes [] = []->         doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs->         doubleUpQuotes (c:cs) = c:doubleUpQuotes cs  > valueExpr (NumLit s) = text s-> valueExpr (IntervalLit v u p) =->     text "interval" <+> quotes (text v)->     <+> text u->     <+> maybe empty (parens . text . show ) p-> valueExpr (Iden i) = name i+> valueExpr (IntervalLit s v f t) =+>     text "interval"+>     <+> me (\x -> if x then text "+" else text "-") s+>     <+> quotes (text v)+>     <+> intervalTypeField f+>     <+> me (\x -> text "to" <+> intervalTypeField x) t+> valueExpr (Iden i) = names i > valueExpr Star = text "*" > valueExpr Parameter = text "?"+> valueExpr (HostParameter p i) =+>     text (':':p)+>     <+> me (\i' -> text "indicator" <+> text (':':i')) i -> valueExpr (App f es) = name f <> parens (commaSep (map valueExpr es))+> valueExpr (App f es) = names f <> parens (commaSep (map valueExpr es)) -> valueExpr (AggregateApp f d es od) =->     name f+> valueExpr (AggregateApp f d es od fil) =+>     names f >     <> parens ((case d of->                   Just Distinct -> text "distinct"->                   Just All -> text "all"->                   Nothing -> empty)+>                   Distinct -> text "distinct"+>                   All -> text "all"+>                   SQDefault -> empty) >                <+> commaSep (map valueExpr es) >                <+> orderBy od)+>     <+> me (\x -> text "filter"+>                   <+> parens (text "where" <+> valueExpr x)) fil +> valueExpr (AggregateAppGroup f es od) =+>     names f+>     <> parens (commaSep (map valueExpr es))+>     <+> if null od+>         then empty+>         else text "within group" <+> parens(orderBy od)+ > valueExpr (WindowApp f es pb od fr) =->     name f <> parens (commaSep $ map valueExpr es)+>     names f <> parens (commaSep $ map valueExpr es) >     <+> text "over" >     <+> parens ((case pb of >                     [] -> empty >                     _ -> text "partition by" >                           <+> nest 13 (commaSep $ map valueExpr pb)) >                 <+> orderBy od->     <+> maybe empty frd fr)+>     <+> me frd fr) >   where >     frd (FrameFrom rs fp) = rsd rs <+> fpd fp >     frd (FrameBetween rs fps fpe) =@@ -81,43 +93,43 @@ >     fpd (Preceding e) = valueExpr e <+> text "preceding" >     fpd (Following e) = valueExpr e <+> text "following" -> valueExpr (SpecialOp nm [a,b,c]) | nm `elem` [Name "between"->                                               ,Name "not between"] =+> valueExpr (SpecialOp nm [a,b,c]) | nm `elem` [[Name "between"]+>                                              ,[Name "not between"]] = >   sep [valueExpr a->       ,name nm <+> valueExpr b->       ,nest (length (unname nm) + 1) $ text "and" <+> valueExpr c]+>       ,names nm <+> valueExpr b+>       ,nest (length (unnames nm) + 1) $ text "and" <+> valueExpr c] -> valueExpr (SpecialOp (Name "rowctor") as) =+> valueExpr (SpecialOp [Name "rowctor"] as) = >     parens $ commaSep $ map valueExpr as  > valueExpr (SpecialOp nm es) =->   name nm <+> parens (commaSep $ map valueExpr es)+>   names nm <+> parens (commaSep $ map valueExpr es)  > valueExpr (SpecialOpK nm fs as) =->     name nm <> parens (sep $ catMaybes+>     names nm <> parens (sep $ catMaybes >         (fmap valueExpr fs >          : map (\(n,e) -> Just (text n <+> valueExpr e)) as)) -> valueExpr (PrefixOp f e) = name f <+> valueExpr e-> valueExpr (PostfixOp f e) = valueExpr e <+> name f-> valueExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] =+> valueExpr (PrefixOp f e) = names f <+> valueExpr e+> valueExpr (PostfixOp f e) = valueExpr e <+> names f+> valueExpr e@(BinOp _ op _) | op `elem` [[Name "and"], [Name "or"]] = >     -- special case for and, or, get all the ands so we can vcat them >     -- nicely >     case ands e of >       (e':es) -> vcat (valueExpr e'->                        : map ((name op <+>) . valueExpr) es)+>                        : map ((names op <+>) . valueExpr) 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 (BinOp e0 (Name ".") e1) =+> valueExpr (BinOp e0 [Name "."] e1) = >     valueExpr e0 <> text "." <> valueExpr e1 > valueExpr (BinOp e0 f e1) =->     valueExpr e0 <+> name f <+> valueExpr e1+>     valueExpr e0 <+> names f <+> valueExpr e1  > valueExpr (Case t ws els) =->     sep $ [text "case" <+> maybe empty valueExpr t]+>     sep $ [text "case" <+> me valueExpr t] >           ++ map w ws >           ++ maybeToList (fmap e els) >           ++ [text "end"]@@ -139,11 +151,24 @@ >     (case ty of >         SqSq -> empty >         SqExists -> text "exists"->         SqAll -> text "all"->         SqSome -> text "some"->         SqAny -> text "any"+>         SqUnique -> text "unique" >     ) <+> parens (queryExpr qe) +> valueExpr (QuantifiedComparison v c cp sq) =+>     valueExpr v+>     <+> names c+>     <+> (text $ case cp of+>              CPAny -> "any"+>              CPSome -> "some"+>              CPAll -> "all")+>     <+> parens (queryExpr sq)++> valueExpr (Match v u sq) =+>     valueExpr v+>     <+> text "match"+>     <+> (if u then text "unique" else empty)+>     <+> parens (queryExpr sq)+ > valueExpr (In b se x) = >     valueExpr se <+> >     (if b then empty else text "not")@@ -153,28 +178,143 @@ >                      InList es -> commaSep $ map valueExpr es >                      InQueryExpr qe -> queryExpr qe) +> valueExpr (Array v es) =+>     valueExpr v <> brackets (commaSep $ map valueExpr es)++> valueExpr (ArrayCtor q) =+>     text "array" <> parens (queryExpr q)++> valueExpr (MultisetCtor es) =+>     text "multiset" <> brackets (commaSep $ map valueExpr es)++> valueExpr (MultisetQueryCtor q) =+>     text "multiset" <> parens (queryExpr q)++> valueExpr (MultisetBinOp a c q b) =+>     sep+>     [valueExpr a+>     ,text "multiset"+>     ,text $ case c of+>                 Union -> "union"+>                 Intersect -> "intersect"+>                 Except -> "except"+>     ,case q of+>          SQDefault -> empty+>          All -> text "all"+>          Distinct -> text "distinct"+>     ,valueExpr b]++++> valueExpr (CSStringLit cs st) =+>   text cs <> quotes (text $ doubleUpQuotes st)++> valueExpr (Escape v e) =+>     valueExpr v <+> text "escape" <+> text [e]++> valueExpr (UEscape v e) =+>     valueExpr v <+> text "uescape" <+> text [e]++> valueExpr (Collate v c) =+>     valueExpr v <+> text "collate" <+> names c++> valueExpr (NextValueFor ns) =+>     text "next value for" <+> names ns+++> doubleUpQuotes :: String -> String+> doubleUpQuotes [] = []+> doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs+> doubleUpQuotes (c:cs) = c:doubleUpQuotes cs++> doubleUpDoubleQuotes :: String -> String+> doubleUpDoubleQuotes [] = []+> doubleUpDoubleQuotes ('"':cs) = '"':'"':doubleUpDoubleQuotes cs+> doubleUpDoubleQuotes (c:cs) = c:doubleUpDoubleQuotes cs+++ > unname :: Name -> String-> unname (QName n) = "\"" ++ n ++ "\""+> unname (QName n) = "\"" ++ doubleUpDoubleQuotes n ++ "\""+> unname (UQName n) = "U&\"" ++ doubleUpDoubleQuotes n ++ "\"" > unname (Name n) = n +> unnames :: [Name] -> String+> unnames ns = intercalate "." $ map unname ns++ > name :: Name -> Doc-> name (QName n) = doubleQuotes $ text n+> name (QName n) = doubleQuotes $ text $ doubleUpDoubleQuotes n+> name (UQName n) =+>     text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n) > name (Name n) = text n +> names :: [Name] -> Doc+> names ns = hcat $ punctuate (text ".") $ map name ns+ > typeName :: TypeName -> Doc-> typeName (TypeName t) = text t-> typeName (PrecTypeName t a) = text t <+> parens (text $ show a)+> typeName (TypeName t) = names t+> typeName (PrecTypeName t a) = names t <+> parens (text $ show a) > typeName (PrecScaleTypeName t a b) =->     text t <+> parens (text (show a) <+> comma <+> text (show b))+>     names t <+> parens (text (show a) <+> comma <+> text (show b))+> typeName (PrecLengthTypeName t i m u) =+>     names t+>     <> parens (text (show i)+>                <> me (\x -> case x of+>                            PrecK -> text "K"+>                            PrecM -> text "M"+>                            PrecG -> text "G"+>                            PrecT -> text "T"+>                            PrecP -> text "P") m+>                <+> me (\x -> case x of+>                        PrecCharacters -> text "CHARACTERS"+>                        PrecOctets -> text "OCTETS") u)+> typeName (CharTypeName t i cs col) =+>     names t+>     <> me (\x -> parens (text $ show x)) i+>     <+> (if null cs+>          then empty+>          else text "character set" <+> names cs)+>     <+> (if null col+>          then empty+>          else text "collate" <+> names col)+> typeName (TimeTypeName t i tz) =+>     names t+>     <> me (\x -> parens (text $ show x)) i+>     <+> text (if tz+>               then "with time zone"+>               else "without time zone")+> typeName (RowTypeName cs) =+>     text "row" <> parens (commaSep $ map f cs)+>   where+>     f (n,t) = name n <+> typeName t+> typeName (IntervalTypeName f t) =+>     text "interval"+>     <+> intervalTypeField f+>     <+> me (\x -> text "to" <+> intervalTypeField x) t +> typeName (ArrayTypeName tn sz) =+>     typeName tn <+> text "array" <+> me (brackets . text . show) sz +> typeName (MultisetTypeName tn) =+>     typeName tn <+> text "multiset"++> intervalTypeField :: IntervalTypeField -> Doc+> intervalTypeField (Itf n p) =+>     text n+>     <+> me (\(x,x1) ->+>              parens (text (show x)+>                      <+> me (\y -> (sep [comma,text (show y)])) x1)) p++ = query expressions  > queryExpr :: QueryExpr -> Doc > queryExpr (Select d sl fr wh gb hv od off fe) = >   sep [text "select" >       ,case d of->           All -> empty+>           SQDefault -> empty+>           All -> text "all" >           Distinct -> text "distinct" >       ,nest 7 $ sep [selectList sl] >       ,from fr@@ -182,9 +322,9 @@ >       ,grpBy gb >       ,maybeValueExpr "having" hv >       ,orderBy od->       ,maybe empty (\e -> text "offset" <+> valueExpr e <+> text "rows") off->       ,maybe empty (\e -> text "fetch first" <+> valueExpr e->                           <+> text "rows only") fe+>       ,me (\e -> text "offset" <+> valueExpr e <+> text "rows") off+>       ,me (\e -> text "fetch first" <+> valueExpr e+>                  <+> text "rows only") fe >       ] > queryExpr (CombineQueryExpr q1 ct d c q2) = >   sep [queryExpr q1@@ -193,7 +333,8 @@ >                 Intersect -> "intersect" >                 Except -> "except") >        <+> case d of->                All -> empty+>                SQDefault -> empty+>                All -> text "all" >                Distinct -> text "distinct" >        <+> case c of >                Corresponding -> text "corresponding"@@ -208,18 +349,18 @@ > queryExpr (Values vs) = >     text "values" >     <+> nest 7 (commaSep (map (parens . commaSep . map valueExpr) vs))-> queryExpr (Table t) = text "table" <+> name t+> queryExpr (Table t) = text "table" <+> names t   > alias :: Alias -> Doc > alias (Alias nm cols) = >     text "as" <+> name nm->     <+> maybe empty (parens . commaSep . map name) cols+>     <+> me (parens . commaSep . map name) cols  > selectList :: [(ValueExpr,Maybe Name)] -> Doc > selectList is = commaSep $ map si is >   where->     si (e,al) = valueExpr e <+> maybe empty als al+>     si (e,al) = valueExpr e <+> me als al >     als al = text "as" <+> name al  > from :: [TableRef] -> Doc@@ -228,22 +369,20 @@ >     sep [text "from" >         ,nest 5 $ vcat $ punctuate comma $ map tr ts] >   where->     tr (TRSimple t) = name t+>     tr (TRSimple t) = names t >     tr (TRLateral t) = text "lateral" <+> tr t >     tr (TRFunction f as) =->         name f <> parens (commaSep $ map valueExpr as)+>         names f <> parens (commaSep $ map valueExpr as) >     tr (TRAlias t a) = sep [tr t, alias a] >     tr (TRParens t) = parens $ tr t >     tr (TRQueryExpr q) = parens $ queryExpr q->     tr (TRJoin t0 jt t1 jc) =+>     tr (TRJoin t0 b jt t1 jc) = >        sep [tr t0->            ,joinText jt jc <+> tr t1+>            ,if b then text "natural" else empty+>            ,joinText jt <+> tr t1 >            ,joinCond jc]->     joinText jt jc =->       sep [case jc of->               Just JoinNatural -> text "natural"->               _ -> empty->           ,case jt of+>     joinText jt =+>       sep [case jt of >               JInner -> text "inner" >               JLeft -> text "left" >               JRight -> text "right"@@ -254,10 +393,9 @@ >     joinCond (Just (JoinUsing es)) = >         text "using" <+> parens (commaSep $ map name es) >     joinCond Nothing = empty->     joinCond (Just JoinNatural) = empty  > maybeValueExpr :: String -> Maybe ValueExpr -> Doc-> maybeValueExpr k = maybe empty+> maybeValueExpr k = me >       (\e -> sep [text k >                  ,nest (length k + 1) $ valueExpr e]) @@ -279,7 +417,10 @@ >   where >     f (SortSpec e d n) = >         valueExpr e->         <+> (if d == Asc then empty else text "desc")+>         <+> (case d of+>                   Asc -> text "asc"+>                   Desc -> text "desc"+>                   DirDefault -> empty) >         <+> (case n of >                 NullsOrderDefault -> empty >                 NullsFirst -> text "nulls" <+> text "first"@@ -289,3 +430,6 @@  > commaSep :: [Doc] -> Doc > commaSep ds = sep $ punctuate comma ds++> me :: (a -> Doc) -> Maybe a -> Doc+> me = maybe empty
Language/SQL/SimpleSQL/Syntax.lhs view
@@ -1,16 +1,21 @@  > -- | The AST for SQL queries.+> {-# LANGUAGE DeriveDataTypeable #-} > module Language.SQL.SimpleSQL.Syntax >     (-- * Value expressions >      ValueExpr(..) >     ,Name(..) >     ,TypeName(..)+>     ,IntervalTypeField(..)+>     ,PrecMultiplier(..)+>     ,PrecUnits(..) >     ,SetQuantifier(..) >     ,SortSpec(..) >     ,Direction(..) >     ,NullsOrder(..) >     ,InPredValue(..) >     ,SubQueryExprType(..)+>     ,CompPredQuantifier(..) >     ,Frame(..) >     ,FrameRows(..) >     ,FramePos(..)@@ -27,6 +32,7 @@ >     ,JoinCondition(..) >     ) where +> import Data.Data  > -- | Represents a value expression. This is used for the expressions > -- in select lists. It is also used for expressions in where, group@@ -53,30 +59,38 @@ >       -- | text of interval literal, units of interval precision, >       -- e.g. interval 3 days (3) >     | IntervalLit->       {ilLiteral :: String -- ^ literal text->       ,ilUnits :: String -- ^ units->       ,ilPrecision :: Maybe Int -- ^ precision+>       {ilSign :: Maybe Bool -- ^ true if + used, false if - used+>       ,ilLiteral :: String -- ^ literal text+>       ,ilFrom :: IntervalTypeField+>       ,ilTo :: Maybe IntervalTypeField >       }->       -- | identifier without dots->     | Iden Name+>       -- | identifier with parts separated by dots+>     | Iden [Name] >       -- | star, as in select *, t.*, count(*) >     | Star >       -- | function application (anything that looks like c style >       -- function application syntactically)->     | App Name [ValueExpr]+>     | App [Name] [ValueExpr] >       -- | aggregate application, which adds distinct or all, and >       -- order by, to regular function application >     | AggregateApp->       {aggName :: Name -- ^ aggregate function name->       ,aggDistinct :: Maybe SetQuantifier -- ^ distinct+>       {aggName :: [Name] -- ^ aggregate function name+>       ,aggDistinct :: SetQuantifier -- ^ distinct >       ,aggArgs :: [ValueExpr]-- ^ args >       ,aggOrderBy :: [SortSpec] -- ^ order by+>       ,aggFilter :: Maybe ValueExpr -- ^ filter >       }+>       -- | aggregates with within group+>     | AggregateAppGroup+>       {aggName :: [Name] -- ^ aggregate function name+>       ,aggArgs :: [ValueExpr] -- ^ args+>       ,aggGroup :: [SortSpec] -- ^ within group+>       } >       -- | window application, which adds over (partition by a order >       -- by b) to regular function application. Explicit frames are >       -- not currently supported >     | WindowApp->       {wnName :: Name -- ^ window function name+>       {wnName :: [Name] -- ^ window function name >       ,wnArgs :: [ValueExpr] -- ^ args >       ,wnPartition :: [ValueExpr] -- ^ partition by >       ,wnOrderBy :: [SortSpec] -- ^ order by@@ -85,23 +99,23 @@ >       -- | 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+>     | BinOp ValueExpr [Name] ValueExpr >       -- | Prefix unary operators. This is used for symbol >       -- operators, keyword operators and multiple keyword operators.->     | PrefixOp Name ValueExpr+>     | PrefixOp [Name] ValueExpr >       -- | Postfix unary operators. This is used for symbol >       -- operators, keyword operators and multiple keyword operators.->     | PostfixOp Name ValueExpr+>     | PostfixOp [Name] ValueExpr >       -- | Used for ternary, mixfix and other non orthodox >       -- operators. Currently used for row constructors, and for >       -- between.->     | SpecialOp Name [ValueExpr]+>     | 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 ValueExpr) [(String,ValueExpr)] >       -- | case expression. both flavours supported >     | Case >       {caseTest :: Maybe ValueExpr -- ^ test value@@ -119,60 +133,108 @@ >       -- means not in was used ('a not in (1,2)') >     | In Bool ValueExpr InPredValue >     | Parameter -- ^ Represents a ? in a parameterized query->       deriving (Eq,Show,Read)+>     | HostParameter String (Maybe String) -- ^ represents a host+>                                           -- parameter, e.g. :a. The+>                                           -- Maybe String is for the+>                                           -- indicator, e.g. :var+>                                           -- indicator :nl+>     | QuantifiedComparison+>             ValueExpr+>             [Name] -- operator+>             CompPredQuantifier+>             QueryExpr+>     | Match ValueExpr Bool -- true if unique+>           QueryExpr+>     | Array ValueExpr [ValueExpr] -- ^ represents an array+>                                   -- access expression, or an array ctor+>                                   -- e.g. a[3]. The first+>                                   -- valueExpr is the array, the+>                                   -- second is the subscripts/ctor args+>     | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t)+>     | CSStringLit String String+>     | Escape ValueExpr Char+>     | UEscape ValueExpr Char+>     | Collate ValueExpr [Name]+>     | MultisetBinOp ValueExpr CombineOp SetQuantifier ValueExpr+>     | MultisetCtor [ValueExpr]+>     | MultisetQueryCtor QueryExpr+>     | NextValueFor [Name]+>       deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents an identifier name, which can be quoted or unquoted. > data Name = Name String >           | QName String->             deriving (Eq,Show,Read)+>           | UQName String+>             deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents a type name, used in casts.-> data TypeName = TypeName String->               | PrecTypeName String Int->               | PrecScaleTypeName String Int Int->                 deriving (Eq,Show,Read)+> data TypeName+>     = TypeName [Name]+>     | PrecTypeName [Name] Integer+>     | PrecScaleTypeName [Name] Integer Integer+>     | PrecLengthTypeName [Name] Integer (Maybe PrecMultiplier) (Maybe PrecUnits)+>       -- precision, characterset, collate+>     | CharTypeName [Name] (Maybe Integer) [Name] [Name]+>     | TimeTypeName [Name] (Maybe Integer) Bool -- true == with time zone+>     | RowTypeName [(Name,TypeName)]+>     | IntervalTypeName IntervalTypeField (Maybe IntervalTypeField)+>     | ArrayTypeName TypeName (Maybe Integer)+>     | MultisetTypeName TypeName+>       deriving (Eq,Show,Read,Data,Typeable) +> data IntervalTypeField = Itf String (Maybe (Integer, Maybe Integer))+>                          deriving (Eq,Show,Read,Data,Typeable) +> data PrecMultiplier = PrecK | PrecM | PrecG | PrecT | PrecP+>                       deriving (Eq,Show,Read,Data,Typeable)+> data PrecUnits = PrecCharacters+>                | PrecOctets+>                 deriving (Eq,Show,Read,Data,Typeable)+ > -- | Used for 'expr in (value expression list)', and 'expr in > -- (subquery)' syntax. > data InPredValue = InList [ValueExpr] >                  | InQueryExpr QueryExpr->                    deriving (Eq,Show,Read)+>                    deriving (Eq,Show,Read,Data,Typeable) +not sure if scalar subquery, exists and unique should be represented like this+ > -- | A subquery in a value expression. > data SubQueryExprType >     = -- | exists (query expr) >       SqExists+>       -- | unique (query expr)+>     | SqUnique >       -- | a scalar subquery >     | SqSq->       -- | all (query expr)->     | SqAll->       -- | some (query expr)->     | SqSome->       -- | any (query expr)->     | SqAny->       deriving (Eq,Show,Read)+>       deriving (Eq,Show,Read,Data,Typeable) +> data CompPredQuantifier+>     = CPAny+>     | CPSome+>     | CPAll+>       deriving (Eq,Show,Read,Data,Typeable)+ > -- | Represents one field in an order by list. > data SortSpec = SortSpec ValueExpr Direction NullsOrder->                 deriving (Eq,Show,Read)+>                 deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents 'nulls first' or 'nulls last' in an order by clause. > data NullsOrder = NullsOrderDefault >                 | NullsFirst >                 | NullsLast->                   deriving (Eq,Show,Read)+>                   deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents the frame clause of a window > -- this can be [range | rows] frame_start > -- or [range | rows] between frame_start and frame_end > data Frame = FrameFrom FrameRows FramePos >            | FrameBetween FrameRows FramePos FramePos->              deriving (Eq,Show,Read)+>              deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents whether a window frame clause is over rows or ranges. > data FrameRows = FrameRows | FrameRange->                  deriving (Eq,Show,Read)+>                  deriving (Eq,Show,Read,Data,Typeable)  > -- | represents the start or end of a frame > data FramePos = UnboundedPreceding@@ -180,7 +242,7 @@ >               | Current >               | Following ValueExpr >               | UnboundedFollowing->                 deriving (Eq,Show,Read)+>                 deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents a query expression, which can be: > --@@ -225,8 +287,8 @@ >       ,qeViews :: [(Alias,QueryExpr)] >       ,qeQueryExpression :: QueryExpr} >     | Values [[ValueExpr]]->     | Table Name->       deriving (Eq,Show,Read)+>     | Table [Name]+>       deriving (Eq,Show,Read,Data,Typeable)  TODO: add queryexpr parens to deal with e.g. (select 1 union select 2) union select 3@@ -236,7 +298,7 @@ > -- expr values a little easier. It is defined like this: > -- > -- > makeSelect :: QueryExpr-> -- > makeSelect = Select {qeSetQuantifier = All+> -- > makeSelect = Select {qeSetQuantifier = SQDefault > -- >                     ,qeSelectList = [] > -- >                     ,qeFrom = [] > -- >                     ,qeWhere = Nothing@@ -247,7 +309,7 @@ > -- >                     ,qeFetchFirst = Nothing}  > makeSelect :: QueryExpr-> makeSelect = Select {qeSetQuantifier = All+> makeSelect = Select {qeSetQuantifier = SQDefault >                     ,qeSelectList = [] >                     ,qeFrom = [] >                     ,qeWhere = Nothing@@ -261,14 +323,14 @@ > -- | Represents the Distinct or All keywords, which can be used > -- before a select list, in an aggregate/window function > -- application, or in a query expression set operator.-> data SetQuantifier = Distinct | All deriving (Eq,Show,Read)+> data SetQuantifier = SQDefault | Distinct | All deriving (Eq,Show,Read,Data,Typeable)  > -- | The direction for a column in order by.-> data Direction = Asc | Desc deriving (Eq,Show,Read)+> 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 CombineOp = Union | Except | Intersect deriving (Eq,Show,Read,Data,Typeable) > -- | Corresponding, an option for the set operators.-> data Corresponding = Corresponding | Respectively deriving (Eq,Show,Read)+> data Corresponding = Corresponding | Respectively deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents an item in a group by clause. > data GroupingExpr@@ -277,13 +339,13 @@ >     | Rollup [GroupingExpr] >     | GroupingSets [GroupingExpr] >     | SimpleGroup ValueExpr->       deriving (Eq,Show,Read)+>       deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents a entry in the csv of tables in the from clause.-> data TableRef = -- | from t->                 TRSimple Name->                 -- | from a join b->               | TRJoin TableRef JoinType TableRef (Maybe JoinCondition)+> data TableRef = -- | from t / from s.t+>                 TRSimple [Name]+>                 -- | from a join b, the bool is true if natural was used+>               | TRJoin TableRef Bool JoinType TableRef (Maybe JoinCondition) >                 -- | from (a) >               | TRParens TableRef >                 -- | from a as b(c,d)@@ -291,23 +353,22 @@ >                 -- | from (query expr) >               | TRQueryExpr QueryExpr >                 -- | from function(args)->               | TRFunction Name [ValueExpr]+>               | TRFunction [Name] [ValueExpr] >                 -- | from lateral t >               | TRLateral TableRef->                 deriving (Eq,Show,Read)+>                 deriving (Eq,Show,Read,Data,Typeable)  > -- | Represents an alias for a table valued expression, used in with > -- queries and in from alias, e.g. select a from t u, select a from t u(b), > -- with a(c) as select 1, select * from a. > data Alias = Alias Name (Maybe [Name])->              deriving (Eq,Show,Read)+>              deriving (Eq,Show,Read,Data,Typeable)  > -- | The type of a join. > data JoinType = JInner | JLeft | JRight | JFull | JCross->                 deriving (Eq,Show,Read)+>                 deriving (Eq,Show,Read,Data,Typeable)  > -- | The join condition. > data JoinCondition = JoinOn ValueExpr -- ^ on expr >                    | JoinUsing [Name] -- ^ using (column list)->                    | JoinNatural -- ^ natural join was used->                      deriving (Eq,Show,Read)+>                      deriving (Eq,Show,Read,Data,Typeable)
changelog view
@@ -1,3 +1,74 @@+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.4.0 (updated to dbd48baaa1d1bce3d0d0139b8ffe55370fabe672)+	now targets SQL:2011+	update to ghc 7.8.2+	remove dependency on haskell-src-exts+	derive Data and Typeable in all the syntax types+	improve the error messages a great deal+	sql features:+	parse schema qualified table names in from clause (thanks to Sönke+	  Hahn)+	support multiline string literals+	support colon prefix host parameters and introducer+	support unique predicate+	support match predicate+	support array constructors and subscripting+	support character set literals+	support collate+	support escape for string literals as a postfix operator+	parse schema/whatever qualified ids in various places: identifiers+	  (replaces equivalent functionality using '.' operator), function,+	  aggregate, window function names, explicit tables and functions in+	  from clauses, typenames+	support almost all typename syntax for SQL:2011 (just missing refs)+	support most multiset operations (missing some predicates only,+	  likely to be added before next release)+	support two double quotes in a quoted identifier to represent a+	  quote character in the identifier+	support filter and within group for aggregates+	support next value for+	parse special nullary functions+	annoying changes:+	replace Int with Integer in the syntax+	remove support for parsing clauses after the from clause if there+	  is no from clause+	change the syntax representation of quantified comparison+	  predicates+	change the hardcoded collate keyword in substring and trim to use+	  the new collate postfix operator, this also changes the collation+	  name to be an identifier instead of a string+	represent missing setquantifier as a literal default instead of as+	  the actual default value (all in select, distinct in set+	  operators)+	same for sort directions in order by+	implement complete interval literals (fixed the handling of the+	  interval qualifier)+	make most of the standard reserved words actually reserved (still+	  some gaps)+	change the natural in join abstract syntax to match the concrete+	  syntax instead of combining natural, on and using into one field+	remove support for postgresql limit syntax+	bug fixes:+	fix some trailing whitespace issues in the keyword style functions,+	  e.g. extract(day from x), dealing with trailing whitespace on+	  the parens was fixed+	improve some cases of parsing chained prefix or postfix operators+	  (still some issues here)+	fix bug where the 'as' was incorrectly optional in a 'with+	  expression list item'+	fix bug in set operations where 'all' was assumed as the default+	  instead of 'distinct', e.g. 'select * from t union select * from+	  u' was parsed to 'select * from t union all select * from u'+	  instead of 'select * from t union distinct select * from u'.+	fix corresponding bug where 'distinct' was being pretty printed in+	  this case and 'all' was not since the assumed default was the+	  wrong way round+	fix some trailing junk lexing issues with symbols and number+	  literals+	fix number literals to accept upper case E 0.3.1 (commit 5cba9a1cac19d66166aed2876d809aef892ff59f) 	update to work with ghc 7.8.1 0.3.0 (commit 9e75fa93650b4f1a08d94f4225a243bcc50445ae)
simple-sql-parser.cabal view
@@ -1,14 +1,17 @@ name:                simple-sql-parser-version:             0.3.1+version:             0.4.0 synopsis:            A parser for SQL queries-description:         A parser for SQL queries. Please see the homepage for more information <http://jakewheat.github.io/simple-sql-parser/>. +description:         A parser for SQL queries. Parses most SQL:2011+                     queries. Please see the homepage for more information+                     <http://jakewheat.github.io/simple-sql-parser/>.+ homepage:            http://jakewheat.github.io/simple-sql-parser/ license:             BSD3 license-file:        LICENSE author:              Jake Wheat maintainer:          jakewheatmail@gmail.com-copyright:           Copyright Jake Wheat 2013+copyright:           Copyright Jake Wheat 2013, 2014 category:            Database,Language build-type:          Simple extra-source-files:  README,LICENSE,changelog@@ -27,24 +30,26 @@   exposed-modules:     Language.SQL.SimpleSQL.Pretty,                        Language.SQL.SimpleSQL.Parser,                        Language.SQL.SimpleSQL.Syntax+  Other-Modules:       Language.SQL.SimpleSQL.Errors,+                       Language.SQL.SimpleSQL.Combinators   other-extensions:    TupleSections-  build-depends:       base >=4.6 && <5,+  build-depends:       base >=4.6 && <4.8,                        parsec >=3.1 && <3.2,-                       mtl >=2.1 && <2.2,+                       mtl >=2.1 && <2.3,                        pretty >= 1.1 && < 1.2   -- hs-source-dirs:   default-language:    Haskell2010   ghc-options:         -Wall+  other-extensions:    TupleSections,DeriveDataTypeable  Test-Suite Tests   type:                exitcode-stdio-1.0   main-is:             RunTests.lhs   hs-source-dirs:      .,tools-  Build-Depends:       base >=4.6 && <5,+  Build-Depends:       base >=4.6 && <4.8,                        parsec >=3.1 && <3.2,-                       mtl >=2.1 && <2.2,+                       mtl >=2.1 && <2.3,                        pretty >= 1.1 && < 1.2,-                       haskell-src-exts >= 1.14 && < 1.15,                         HUnit >= 1.2 && < 1.3,                        test-framework >= 0.8 && < 0.9,@@ -53,30 +58,34 @@   Other-Modules:       Language.SQL.SimpleSQL.Pretty,                        Language.SQL.SimpleSQL.Parser,                        Language.SQL.SimpleSQL.Syntax,+                       Language.SQL.SimpleSQL.Errors,+                       Language.SQL.SimpleSQL.Combinators +                       Language.SQL.SimpleSQL.ErrorMessages,                        Language.SQL.SimpleSQL.FullQueries,                        Language.SQL.SimpleSQL.GroupBy,                        Language.SQL.SimpleSQL.Postgres,                        Language.SQL.SimpleSQL.QueryExprComponents,                        Language.SQL.SimpleSQL.QueryExprs,-                       Language.SQL.SimpleSQL.ValueExprs,+                       Language.SQL.SimpleSQL.SQL2011,                        Language.SQL.SimpleSQL.TableRefs,                        Language.SQL.SimpleSQL.TestTypes,                        Language.SQL.SimpleSQL.Tests,-                       Language.SQL.SimpleSQL.Tpch+                       Language.SQL.SimpleSQL.Tpch,+                       Language.SQL.SimpleSQL.ValueExprs -  other-extensions:    TupleSections,OverloadedStrings+  other-extensions:    TupleSections,DeriveDataTypeable   default-language:    Haskell2010   ghc-options:         -Wall  executable SQLIndent   main-is:             SQLIndent.lhs   hs-source-dirs:      .,tools-  Build-Depends:       base >=4.6 && <5,+  Build-Depends:       base >=4.6 && <4.8,                        parsec >=3.1 && <3.2,-                       mtl >=2.1 && <2.2,-                       pretty >= 1.1 && < 1.2,-                       haskell-src-exts >= 1.14 && < 1.15+                       mtl >=2.1 && <2.3,+                       pretty >= 1.1 && < 1.2+  other-extensions:    TupleSections,DeriveDataTypeable   default-language:    Haskell2010   ghc-options:         -Wall   if flag(sqlindent)
+ tools/Language/SQL/SimpleSQL/ErrorMessages.lhs view
@@ -0,0 +1,149 @@++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
@@ -1,7 +1,6 @@  Some tests for parsing full queries. -> {-# LANGUAGE OverloadedStrings #-} > module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where  > import Language.SQL.SimpleSQL.TestTypes@@ -12,8 +11,8 @@ > fullQueriesTests = Group "queries" $ map (uncurry TestQueryExpr) >     [("select count(*) from t" >      ,makeSelect->       {qeSelectList = [(App "count" [Star], Nothing)]->       ,qeFrom = [TRSimple "t"]+>       {qeSelectList = [(App [Name "count"] [Star], Nothing)]+>       ,qeFrom = [TRSimple [Name "t"]] >       } >      ) @@ -24,16 +23,17 @@ >       \  having count(1) > 5\n\ >       \  order by s" >      ,makeSelect->       {qeSelectList = [(Iden "a", Nothing)->                       ,(App "sum" [BinOp (Iden "c")->                                          "+" (Iden "d")]->                        ,Just "s")]->       ,qeFrom = [TRSimple "t", TRSimple "u"]->       ,qeWhere = Just $ BinOp (Iden "a") ">" (NumLit "5")->       ,qeGroupBy = [SimpleGroup $ Iden "a"]->       ,qeHaving = Just $ BinOp (App "count" [NumLit "1"])->                                ">" (NumLit "5")->       ,qeOrderBy = [SortSpec (Iden "s") Asc NullsOrderDefault]+>       {qeSelectList = [(Iden [Name "a"], Nothing)+>                       ,(App [Name "sum"]+>                         [BinOp (Iden [Name "c"])+>                                [Name "+"] (Iden [Name "d"])]+>                        ,Just $ Name "s")]+>       ,qeFrom = [TRSimple [Name "t"], TRSimple [Name "u"]]+>       ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5")+>       ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]]+>       ,qeHaving = Just $ BinOp (App [Name "count"] [NumLit "1"])+>                                [Name ">"] (NumLit "5")+>       ,qeOrderBy = [SortSpec (Iden [Name "s"]) DirDefault NullsOrderDefault] >       } >      ) >     ]
tools/Language/SQL/SimpleSQL/GroupBy.lhs view
@@ -1,7 +1,6 @@  Here are the tests for the group by component of query exprs -> {-# LANGUAGE OverloadedStrings #-} > module Language.SQL.SimpleSQL.GroupBy (groupByTests) where  > import Language.SQL.SimpleSQL.TestTypes@@ -18,19 +17,19 @@ > simpleGroupBy :: TestItem > simpleGroupBy = Group "simpleGroupBy" $ map (uncurry TestQueryExpr) >     [("select a,sum(b) from t group by a"->      ,makeSelect {qeSelectList = [(Iden "a",Nothing)->                                  ,(App "sum" [Iden "b"],Nothing)]->                  ,qeFrom = [TRSimple "t"]->                  ,qeGroupBy = [SimpleGroup $ Iden "a"]+>      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)+>                                  ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]+>                  ,qeFrom = [TRSimple [Name "t"]]+>                  ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]] >                  })  >     ,("select a,b,sum(c) from t group by a,b"->      ,makeSelect {qeSelectList = [(Iden "a",Nothing)->                                  ,(Iden "b",Nothing)->                                  ,(App "sum" [Iden "c"],Nothing)]->                  ,qeFrom = [TRSimple "t"]->                  ,qeGroupBy = [SimpleGroup $ Iden "a"->                               ,SimpleGroup $ Iden "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"]] >                  }) >     ] @@ -42,15 +41,15 @@ >     [("select * from t group by ()", ms [GroupingParens []]) >     ,("select * from t group by grouping sets ((), (a))" >      ,ms [GroupingSets [GroupingParens []->                        ,GroupingParens [SimpleGroup $ Iden "a"]]])+>                        ,GroupingParens [SimpleGroup $ Iden [Name "a"]]]]) >     ,("select * from t group by cube(a,b)"->      ,ms [Cube [SimpleGroup $ Iden "a", SimpleGroup $ Iden "b"]])+>      ,ms [Cube [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]]) >     ,("select * from t group by rollup(a,b)"->      ,ms [Rollup [SimpleGroup $ Iden "a", SimpleGroup $ Iden "b"]])+>      ,ms [Rollup [SimpleGroup $ Iden [Name "a"], SimpleGroup $ Iden [Name "b"]]]) >     ] >   where >     ms g = makeSelect {qeSelectList = [(Star,Nothing)]->                       ,qeFrom = [TRSimple "t"]+>                       ,qeFrom = [TRSimple [Name "t"]] >                       ,qeGroupBy = g}  > randomGroupBy :: TestItem@@ -221,11 +220,14 @@ >      \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-} >      -- as group - needs more subtle keyword blacklisting +>     -- decimal as a function not allowed due to the reserved keyword+>     -- handling: todo, review if this is ansi standard function or+>     -- if there are places where reserved keywords can still be used >     ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\ >      \REGION,\n\ >      \SUM(SALES) AS UNITS_SOLD,\n\ >      \MAX(SALES) AS BEST_SALE,\n\->      \CAST(ROUND(AVG(DECIMAL(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\+>      \CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\ >      \FROM SALES\n\ >      \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\ >      \ORDER BY MONTH, REGION"
tools/Language/SQL/SimpleSQL/Postgres.lhs view
@@ -29,7 +29,9 @@  >     ,"SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');" ->     ,"SELECT ROW(table.*) IS NULL FROM table;"+>     -- table is a reservered keyword?+>     --,"SELECT ROW(table.*) IS NULL FROM table;"+>     ,"SELECT ROW(tablex.*) IS NULL FROM tablex;"  >     ,"SELECT true OR somefunc();" @@ -102,6 +104,8 @@  >     ,"SELECT x FROM test1 GROUP BY x;" >     ,"SELECT x, sum(y) FROM test1 GROUP BY x;"+>     -- s.date changed to s.datex because of reserved keyword+>     -- handling, not sure if this is correct or not for ansi sql >     ,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\ >      \    FROM products p LEFT JOIN sales s USING (product_id)\n\ >      \    GROUP BY product_id, p.name, p.price;"@@ -110,7 +114,7 @@ >     ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';" >     ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\ >      \    FROM products p LEFT JOIN sales s USING (product_id)\n\->      \    WHERE s.date > CURRENT_DATE - INTERVAL '4 weeks'\n\+>      \    WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\ >      \    GROUP BY product_id, p.name, p.price, p.cost\n\ >      \    HAVING sum(p.price * s.units) > 5000;" @@ -214,7 +218,7 @@ >      \  UNION ALL\n\ >      \    SELECT n+1 FROM t\n\ >      \)\n\->      \SELECT n FROM t LIMIT 100;"+>      \SELECT n FROM t --LIMIT 100;" -- limit is not standard  select page reference @@ -264,6 +268,8 @@  >     ,"SELECT 2+2;" ->     ,"SELECT distributors.* WHERE distributors.name = 'Westward';"+>     -- simple-sql-parser doesn't support where without from+>     -- this can be added for the postgres dialect when it is written+>     --,"SELECT distributors.* WHERE distributors.name = 'Westward';"  >     ]
tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs view
@@ -5,7 +5,6 @@  These are a few misc tests which don't fit anywhere else. -> {-# LANGUAGE OverloadedStrings #-} > module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where  > import Language.SQL.SimpleSQL.TestTypes@@ -30,15 +29,15 @@  > duplicates :: TestItem > duplicates = Group "duplicates" $ map (uncurry TestQueryExpr)->     [("select a from t" ,ms All)+>     [("select a from t" ,ms SQDefault) >     ,("select all a from t" ,ms All) >     ,("select distinct a from t", ms Distinct) >     ] >  where >    ms d = makeSelect >           {qeSetQuantifier = d->           ,qeSelectList = [(Iden "a",Nothing)]->           ,qeFrom = [TRSimple "t"]}+>           ,qeSelectList = [(Iden [Name "a"],Nothing)]+>           ,qeFrom = [TRSimple [Name "t"]]}  > selectLists :: TestItem > selectLists = Group "selectLists" $ map (uncurry TestQueryExpr)@@ -46,29 +45,29 @@ >       makeSelect {qeSelectList = [(NumLit "1",Nothing)]})  >     ,("select a"->      ,makeSelect {qeSelectList = [(Iden "a",Nothing)]})+>      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]})  >     ,("select a,b"->      ,makeSelect {qeSelectList = [(Iden "a",Nothing)->                                  ,(Iden "b",Nothing)]})+>      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)+>                                  ,(Iden [Name "b"],Nothing)]})  >     ,("select 1+2,3+4" >      ,makeSelect {qeSelectList =->                      [(BinOp (NumLit "1") "+" (NumLit "2"),Nothing)->                      ,(BinOp (NumLit "3") "+" (NumLit "4"),Nothing)]})+>                      [(BinOp (NumLit "1") [Name "+"] (NumLit "2"),Nothing)+>                      ,(BinOp (NumLit "3") [Name "+"] (NumLit "4"),Nothing)]})  >     ,("select a as a, /*comment*/ b as b"->      ,makeSelect {qeSelectList = [(Iden "a", Just "a")->                                  ,(Iden "b", Just "b")]})+>      ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a")+>                                  ,(Iden [Name "b"], Just $ Name "b")]})  >     ,("select a a, b b"->      ,makeSelect {qeSelectList = [(Iden "a", Just "a")->                                  ,(Iden "b", Just "b")]})+>      ,makeSelect {qeSelectList = [(Iden [Name "a"], Just $ Name "a")+>                                  ,(Iden [Name "b"], Just $ Name "b")]})  >     ,("select a + b * c" >      ,makeSelect {qeSelectList =->       [(BinOp (Iden (Name "a")) (Name "+")->         (BinOp (Iden (Name "b")) (Name "*") (Iden (Name "c")))+>       [(BinOp (Iden [Name "a"]) [Name "+"]+>         (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"])) >        ,Nothing)]})  >     ]@@ -76,47 +75,47 @@ > whereClause :: TestItem > whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) >     [("select a from t where a = 5"->      ,makeSelect {qeSelectList = [(Iden "a",Nothing)]->                  ,qeFrom = [TRSimple "t"]->                  ,qeWhere = Just $ BinOp (Iden "a") "=" (NumLit "5")})+>      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]+>                  ,qeFrom = [TRSimple [Name "t"]]+>                  ,qeWhere = Just $ BinOp (Iden [Name "a"]) [Name "="] (NumLit "5")}) >     ]  > having :: TestItem > having = Group "having" $ map (uncurry TestQueryExpr) >     [("select a,sum(b) from t group by a having sum(b) > 5"->      ,makeSelect {qeSelectList = [(Iden "a",Nothing)->                                  ,(App "sum" [Iden "b"],Nothing)]->                  ,qeFrom = [TRSimple "t"]->                  ,qeGroupBy = [SimpleGroup $ Iden "a"]->                  ,qeHaving = Just $ BinOp (App "sum" [Iden "b"])->                                           ">" (NumLit "5")+>      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)+>                                  ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]+>                  ,qeFrom = [TRSimple [Name "t"]]+>                  ,qeGroupBy = [SimpleGroup $ Iden [Name "a"]]+>                  ,qeHaving = Just $ BinOp (App [Name "sum"] [Iden [Name "b"]])+>                                           [Name ">"] (NumLit "5") >                  }) >     ]  > orderBy :: TestItem > orderBy = Group "orderBy" $ map (uncurry TestQueryExpr) >     [("select a from t order by a"->      ,ms [SortSpec (Iden "a") Asc NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault])  >     ,("select a from t order by a, b"->      ,ms [SortSpec (Iden "a") Asc NullsOrderDefault->          ,SortSpec (Iden "b") Asc NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault+>          ,SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault])  >     ,("select a from t order by a asc"->      ,ms [SortSpec (Iden "a") Asc NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name "a"]) Asc NullsOrderDefault])  >     ,("select a from t order by a desc, b desc"->      ,ms [SortSpec (Iden "a") Desc NullsOrderDefault->          ,SortSpec (Iden "b") Desc NullsOrderDefault])+>      ,ms [SortSpec (Iden [Name "a"]) Desc NullsOrderDefault+>          ,SortSpec (Iden [Name "b"]) Desc NullsOrderDefault])  >     ,("select a from t order by a desc nulls first, b desc nulls last"->      ,ms [SortSpec (Iden "a") Desc NullsFirst->          ,SortSpec (Iden "b") Desc NullsLast])+>      ,ms [SortSpec (Iden [Name "a"]) Desc NullsFirst+>          ,SortSpec (Iden [Name "b"]) Desc NullsLast])  >     ] >   where->     ms o = makeSelect {qeSelectList = [(Iden "a",Nothing)]->                       ,qeFrom = [TRSimple "t"]+>     ms o = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]+>                       ,qeFrom = [TRSimple [Name "t"]] >                       ,qeOrderBy = o}  > offsetFetch :: TestItem@@ -130,24 +129,25 @@ >      ,ms Nothing (Just $ NumLit "10")) >     ,("select a from t offset 5 row fetch first 10 row only" >      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))->      -- postgres->     ,("select a from t limit 10 offset 5"->      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))+>      -- postgres: disabled, will add back when postgres+>      -- dialect is added+>     --,("select a from t limit 10 offset 5"+>     -- ,ms (Just $ NumLit "5") (Just $ NumLit "10")) >     ] >   where >     ms o l = makeSelect->              {qeSelectList = [(Iden "a",Nothing)]->              ,qeFrom = [TRSimple "t"]+>              {qeSelectList = [(Iden [Name "a"],Nothing)]+>              ,qeFrom = [TRSimple [Name "t"]] >              ,qeOffset = o >              ,qeFetchFirst = l}  > combos :: TestItem > combos = Group "combos" $ map (uncurry TestQueryExpr) >     [("select a from t union select b from u"->      ,CombineQueryExpr ms1 Union All Respectively ms2)+>      ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)  >     ,("select a from t intersect select b from u"->      ,CombineQueryExpr ms1 Intersect All Respectively ms2)+>      ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2)  >     ,("select a from t except all select b from u" >      ,CombineQueryExpr ms1 Except All Respectively ms2)@@ -160,38 +160,38 @@ >      -- 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 All Respectively->        (CombineQueryExpr ms1 Union All Respectively ms1))+>      ,CombineQueryExpr ms1 Union SQDefault Respectively+>        (CombineQueryExpr ms1 Union SQDefault Respectively ms1)) >     ] >   where >     ms1 = makeSelect->           {qeSelectList = [(Iden "a",Nothing)]->           ,qeFrom = [TRSimple "t"]}+>           {qeSelectList = [(Iden [Name "a"],Nothing)]+>           ,qeFrom = [TRSimple [Name "t"]]} >     ms2 = makeSelect->           {qeSelectList = [(Iden "b",Nothing)]->           ,qeFrom = [TRSimple "u"]}+>           {qeSelectList = [(Iden [Name "b"],Nothing)]+>           ,qeFrom = [TRSimple [Name "u"]]}   > withQueries :: TestItem > withQueries = Group "with queries" $ map (uncurry TestQueryExpr) >     [("with u as (select a from t) select a from u"->      ,With False [(Alias "u" Nothing, ms1)] ms2)+>      ,With False [(Alias (Name "u") Nothing, ms1)] ms2)  >     ,("with u(b) as (select a from t) select a from u"->      ,With False [(Alias "u" (Just ["b"]), ms1)] ms2)+>      ,With False [(Alias (Name "u") (Just [Name "b"]), ms1)] ms2)  >     ,("with x as (select a from t),\n\ >       \     u as (select a from x)\n\ >       \select a from u"->      ,With False [(Alias "x" Nothing, ms1), (Alias "u" Nothing,ms3)] ms2)+>      ,With False [(Alias (Name "x") Nothing, ms1), (Alias (Name "u") Nothing,ms3)] ms2)  >     ,("with recursive u as (select a from t) select a from u"->      ,With True [(Alias "u" Nothing, ms1)] ms2)+>      ,With True [(Alias (Name "u") Nothing, ms1)] ms2) >     ] >  where >    ms c t = makeSelect->             {qeSelectList = [(Iden c,Nothing)]->             ,qeFrom = [TRSimple t]}+>             {qeSelectList = [(Iden [Name c],Nothing)]+>             ,qeFrom = [TRSimple [Name t]]} >    ms1 = ms "a" "t" >    ms2 = ms "a" "u" >    ms3 = ms "a" "x"@@ -205,5 +205,5 @@  > tables :: TestItem > tables = Group "tables" $ map (uncurry TestQueryExpr)->     [("table tbl", Table "tbl")+>     [("table tbl", Table [Name "tbl"]) >     ]
+ tools/Language/SQL/SimpleSQL/SQL2011.lhs view
@@ -0,0 +1,4309 @@++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)+>     [("'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)+>     [("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)+>     [("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)+>     [--("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     $ 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)+>     [("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)+>     [("(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) $+>     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)+>     [(":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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>    [("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)+>    [("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)+>    [("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)+>     [("(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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     -- 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)+>     [("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)+>     [-- 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)+>     $ 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)++>     [("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)+>     [("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)+>     [("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)+>     [("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)+>     [("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) $+>     [("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)+>     [("select * from t order by a"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a,b"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])+>                            DirDefault NullsOrderDefault+>                       ,SortSpec (Iden [Name "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a asc,b"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])+>                            Asc NullsOrderDefault+>                       ,SortSpec (Iden [Name "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a desc,b"+>      ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])+>                            Desc NullsOrderDefault+>                       ,SortSpec (Iden [Name "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by a collate x desc,b"+>      ,qe {qeOrderBy = [SortSpec+>                            (Collate (Iden [Name "a"]) [Name "x"])+>                            Desc NullsOrderDefault+>                       ,SortSpec (Iden [Name "b"])+>                            DirDefault NullsOrderDefault]})+>     ,("select * from t order by 1,2"+>      ,qe {qeOrderBy = [SortSpec (NumLit "1")+>                            DirDefault NullsOrderDefault+>                       ,SortSpec (NumLit "2")+>                            DirDefault NullsOrderDefault]})+>     ]+>   where+>     qe = makeSelect+>          {qeSelectList = [(Star,Nothing)]+>          ,qeFrom = [TRSimple [Name "t"]]}
tools/Language/SQL/SimpleSQL/TableRefs.lhs view
@@ -2,7 +2,6 @@ These are the tests for parsing focusing on the from part of query expression -> {-# LANGUAGE OverloadedStrings #-} > module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where  > import Language.SQL.SimpleSQL.TestTypes@@ -12,93 +11,95 @@ > tableRefTests :: TestItem > tableRefTests = Group "tableRefTests" $ map (uncurry TestQueryExpr) >     [("select a from t"->      ,ms [TRSimple "t"])+>      ,ms [TRSimple [Name "t"]])  >      ,("select a from f(a)"->       ,ms [TRFunction "f" [Iden "a"]])+>       ,ms [TRFunction [Name "f"] [Iden [Name "a"]]])  >     ,("select a from t,u"->      ,ms [TRSimple "t", TRSimple "u"])+>      ,ms [TRSimple [Name "t"], TRSimple [Name "u"]]) +>     ,("select a from s.t"+>      ,ms [TRSimple [Name "s", Name "t"]])+ these lateral queries make no sense but the syntax is valid  >     ,("select a from lateral a"->      ,ms [TRLateral $ TRSimple "a"])+>      ,ms [TRLateral $ TRSimple [Name "a"]])  >     ,("select a from lateral a,b"->      ,ms [TRLateral $ TRSimple "a", TRSimple "b"])+>      ,ms [TRLateral $ TRSimple [Name "a"], TRSimple [Name "b"]])  >     ,("select a from a, lateral b"->      ,ms [TRSimple "a", TRLateral $ TRSimple "b"])+>      ,ms [TRSimple [Name "a"], TRLateral $ TRSimple [Name "b"]])  >     ,("select a from a natural join lateral b"->      ,ms [TRJoin (TRSimple "a") JInner->                  (TRLateral $ TRSimple "b")->                  (Just JoinNatural)])+>      ,ms [TRJoin (TRSimple [Name "a"]) True JInner+>                  (TRLateral $ TRSimple [Name "b"])+>                  Nothing]) ->     -- the lateral binds on the outside of the join which is incorrect >     ,("select a from lateral a natural join lateral b"->      ,ms [TRJoin (TRLateral $ TRSimple "a") JInner->                  (TRLateral $ TRSimple "b")->                  (Just JoinNatural)])+>      ,ms [TRJoin (TRLateral $ TRSimple [Name "a"]) True JInner+>                  (TRLateral $ TRSimple [Name "b"])+>                  Nothing])   >     ,("select a from t inner join u on expr"->      ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")->                        (Just $ JoinOn $ Iden "expr")])+>      ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])+>                        (Just $ JoinOn $ Iden [Name "expr"])])  >     ,("select a from t join u on expr"->      ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")->                        (Just $ JoinOn $ Iden "expr")])+>      ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])+>                        (Just $ JoinOn $ Iden [Name "expr"])])  >     ,("select a from t left join u on expr"->      ,ms [TRJoin (TRSimple "t") JLeft (TRSimple "u")->                        (Just $ JoinOn $ Iden "expr")])+>      ,ms [TRJoin (TRSimple [Name "t"]) False JLeft (TRSimple [Name "u"])+>                        (Just $ JoinOn $ Iden [Name "expr"])])  >     ,("select a from t right join u on expr"->      ,ms [TRJoin (TRSimple "t") JRight (TRSimple "u")->                        (Just $ JoinOn $ Iden "expr")])+>      ,ms [TRJoin (TRSimple [Name "t"]) False JRight (TRSimple [Name "u"])+>                        (Just $ JoinOn $ Iden [Name "expr"])])  >     ,("select a from t full join u on expr"->      ,ms [TRJoin (TRSimple "t") JFull (TRSimple "u")->                        (Just $ JoinOn $ Iden "expr")])+>      ,ms [TRJoin (TRSimple [Name "t"]) False JFull (TRSimple [Name "u"])+>                        (Just $ JoinOn $ Iden [Name "expr"])])  >     ,("select a from t cross join u"->      ,ms [TRJoin (TRSimple "t")->                        JCross (TRSimple "u") Nothing])+>      ,ms [TRJoin (TRSimple [Name "t"]) False+>                        JCross (TRSimple [Name "u"]) Nothing])  >     ,("select a from t natural inner join u"->      ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")->                        (Just JoinNatural)])+>      ,ms [TRJoin (TRSimple [Name "t"]) True JInner (TRSimple [Name "u"])+>                        Nothing])  >     ,("select a from t inner join u using(a,b)"->      ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")->                        (Just $ JoinUsing ["a", "b"])])+>      ,ms [TRJoin (TRSimple [Name "t"]) False JInner (TRSimple [Name "u"])+>                        (Just $ JoinUsing [Name "a", Name "b"])])  >     ,("select a from (select a from t)"->      ,ms [TRQueryExpr $ ms [TRSimple "t"]])+>      ,ms [TRQueryExpr $ ms [TRSimple [Name "t"]]])  >     ,("select a from t as u"->      ,ms [TRAlias (TRSimple "t") (Alias "u" Nothing)])+>      ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)])  >     ,("select a from t u"->      ,ms [TRAlias (TRSimple "t") (Alias "u" Nothing)])+>      ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") Nothing)])  >     ,("select a from t u(b)"->      ,ms [TRAlias (TRSimple "t") (Alias "u" $ Just ["b"])])+>      ,ms [TRAlias (TRSimple [Name "t"]) (Alias (Name "u") $ Just [Name "b"])])  >     ,("select a from (t cross join u) as u" >      ,ms [TRAlias (TRParens $->                    TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing)->                           (Alias "u" Nothing)])+>                    TRJoin (TRSimple [Name "t"]) False JCross (TRSimple [Name "u"]) Nothing)+>                           (Alias (Name "u") Nothing)]) >      -- todo: not sure if the associativity is correct  >     ,("select a from t cross join u cross join v", >        ms [TRJoin->            (TRJoin (TRSimple "t")->                    JCross (TRSimple "u") Nothing)->            JCross (TRSimple "v") Nothing])+>            (TRJoin (TRSimple [Name "t"]) False+>                    JCross (TRSimple [Name "u"]) Nothing)+>            False JCross (TRSimple [Name "v"]) Nothing]) >     ] >   where->     ms f = makeSelect {qeSelectList = [(Iden "a",Nothing)]+>     ms f = makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)] >                       ,qeFrom = f}
tools/Language/SQL/SimpleSQL/TestTypes.lhs view
@@ -6,8 +6,6 @@  > import Language.SQL.SimpleSQL.Syntax -> import Data.String- > data TestItem = Group String [TestItem] >               | TestValueExpr String ValueExpr >               | TestQueryExpr String QueryExpr@@ -19,8 +17,3 @@  >               | ParseQueryExpr String >                 deriving (Eq,Show)--hack to make the tests a bit simpler--> instance IsString Name where->    fromString = Name
tools/Language/SQL/SimpleSQL/Tests.lhs view
@@ -28,7 +28,7 @@ > import Language.SQL.SimpleSQL.ValueExprs > import Language.SQL.SimpleSQL.Tpch -+> import Language.SQL.SimpleSQL.SQL2011  Order the tests to start from the simplest first. This is also the order on the generated documentation.@@ -44,6 +44,7 @@ >     ,fullQueriesTests >     ,postgresTests >     ,tpchTests+>     ,sql2011Tests >     ]  > tests :: Test.Framework.Test@@ -79,9 +80,12 @@ >                 let str' = pp got >                 let egot' = parser "" Nothing str' >                 case egot' of->                     Left e' -> H.assertFailure $ "pp roundtrip "+>                     Left e' -> H.assertFailure $ "pp roundtrip"+>                                                  ++ "\n" ++ str' >                                                  ++ peFormattedError e'->                     Right got' -> H.assertEqual "pp roundtrip" expected got'+>                     Right got' -> H.assertEqual+>                                   ("pp roundtrip" ++ "\n" ++ str')+>                                    expected got'  > toPTest :: (Eq a, Show a) => >           (String -> Maybe (Int,Int) -> String -> Either ParseError a)@@ -97,5 +101,6 @@ >                 let egot' = parser "" Nothing str' >                 case egot' of >                     Left e' -> H.assertFailure $ "pp roundtrip "+>                                                  ++ "\n" ++ str' ++ "\n" >                                                  ++ peFormattedError e' >                     Right _got' -> return ()
tools/Language/SQL/SimpleSQL/ValueExprs.lhs view
@@ -1,7 +1,6 @@  Tests for parsing value expressions -> {-# LANGUAGE OverloadedStrings #-} > module Language.SQL.SimpleSQL.ValueExprs (valueExprTests) where  > import Language.SQL.SimpleSQL.TestTypes@@ -38,16 +37,18 @@ >      ,("'string'", StringLit "string") >      ,("'string with a '' quote'", StringLit "string with a ' quote") >      ,("'1'", StringLit "1")->      ,("interval '3' day", IntervalLit "3" "day" Nothing)->      ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3)->      ,("interval '3 weeks'", TypedLit (TypeName "interval") "3 weeks")+>      ,("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)->     [("iden1", Iden "iden1")+>     [("iden1", Iden [Name "iden1"]) >     --,("t.a", Iden2 "t" "a")->     ,("\"quoted identifier\"", Iden $ QName "quoted identifier")+>     ,("\"quoted identifier\"", Iden [QName "quoted identifier"]) >     ]  > star :: TestItem@@ -65,41 +66,41 @@  > dots :: TestItem > dots = Group "dot" $ map (uncurry TestValueExpr)->     [("t.a", BinOp (Iden "t") "." (Iden "a"))->     ,("t.*", BinOp (Iden "t") "." Star)->     ,("a.b.c", BinOp (BinOp (Iden "a") "." (Iden "b")) "." (Iden "c"))->     ,("ROW(t.*,42)", App "ROW" [BinOp (Iden "t") "." Star, NumLit "42"])+>     [("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)->     [("f()", App "f" [])->     ,("f(a)", App "f" [Iden "a"])->     ,("f(a,b)", App "f" [Iden "a", Iden "b"])+>     [("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) >     [("case a when 1 then 2 end"->      ,Case (Just $ Iden "a") [([NumLit "1"]+>      ,Case (Just $ Iden [Name "a"]) [([NumLit "1"] >                               ,NumLit "2")] Nothing)  >     ,("case a when 1 then 2 when 3 then 4 end"->      ,Case (Just $ Iden "a") [([NumLit "1"], NumLit "2")+>      ,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 "a") [([NumLit "1"], NumLit "2")+>      ,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 "a") "=" (NumLit "1")], NumLit "2")->                    ,([BinOp (Iden "a") "=" (NumLit "3")], NumLit "4")]+>      ,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 "a") [([NumLit "1",NumLit "2"]+>      ,Case (Just $ Iden [Name "a"]) [([NumLit "1",NumLit "2"] >                                ,NumLit "10") >                              ,([NumLit "3",NumLit "4"] >                                ,NumLit "20")]@@ -116,49 +117,48 @@  > binaryOperators :: TestItem > binaryOperators = Group "binaryOperators" $ map (uncurry TestValueExpr)->     [("a + b", BinOp (Iden "a") "+" (Iden "b"))+>     [("a + b", BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"])) >      -- sanity check fixities >      -- todo: add more fixity checking  >     ,("a + b * c"->      ,BinOp  (Iden "a") "+"->              (BinOp (Iden "b") "*" (Iden "c")))+>      ,BinOp  (Iden [Name "a"]) [Name "+"]+>              (BinOp (Iden [Name "b"]) [Name "*"] (Iden [Name "c"])))  >     ,("a * b + c"->      ,BinOp (BinOp (Iden "a") "*" (Iden "b"))->             "+" (Iden "c"))+>      ,BinOp (BinOp (Iden [Name "a"]) [Name "*"] (Iden [Name "b"]))+>             [Name "+"] (Iden [Name "c"])) >     ]  > unaryOperators :: TestItem > unaryOperators = Group "unaryOperators" $ map (uncurry TestValueExpr)->     [("not a", PrefixOp "not" $ Iden "a")->      -- I think this is a missing feature or bug in parsec buildExpressionParser->     --,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a")->     ,("+a", PrefixOp "+" $ Iden "a")->     ,("-a", PrefixOp "-" $ Iden "a")+>     [("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) >     [("cast('1' as int)"->      ,Cast (StringLit "1") $ TypeName "int")+>      ,Cast (StringLit "1") $ TypeName [Name "int"])  >     ,("int '3'"->      ,TypedLit (TypeName "int") "3")+>      ,TypedLit (TypeName [Name "int"]) "3")  >     ,("cast('1' as double precision)"->      ,Cast (StringLit "1") $ TypeName "double precision")+>      ,Cast (StringLit "1") $ TypeName [Name "double precision"])  >     ,("cast('1' as float(8))"->      ,Cast (StringLit "1") $ PrecTypeName "float" 8)+>      ,Cast (StringLit "1") $ PrecTypeName [Name "float"] 8)  >     ,("cast('1' as decimal(15,2))"->      ,Cast (StringLit "1") $ PrecScaleTypeName "decimal" 15 2)+>      ,Cast (StringLit "1") $ PrecScaleTypeName [Name "decimal"] 15 2)   >     ,("double precision '3'"->      ,TypedLit (TypeName "double precision") "3")+>      ,TypedLit (TypeName [Name "double precision"]) "3") >     ]  > subqueries :: TestItem@@ -167,113 +167,113 @@ >     ,("(select a from t)", SubQueryExpr SqSq ms)  >     ,("a in (select a from t)"->      ,In True (Iden "a") (InQueryExpr ms))+>      ,In True (Iden [Name "a"]) (InQueryExpr ms))  >     ,("a not in (select a from t)"->      ,In False (Iden "a") (InQueryExpr ms))+>      ,In False (Iden [Name "a"]) (InQueryExpr ms))  >     ,("a > all (select a from t)"->      ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms))+>      ,QuantifiedComparison (Iden [Name "a"]) [Name ">"] CPAll ms)  >     ,("a = some (select a from t)"->      ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms))+>      ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPSome ms)  >     ,("a <= any (select a from t)"->      ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms))+>      ,QuantifiedComparison (Iden [Name "a"]) [Name "<="] CPAny ms) >     ] >   where >     ms = makeSelect->          {qeSelectList = [(Iden "a",Nothing)]->          ,qeFrom = [TRSimple "t"]+>          {qeSelectList = [(Iden [Name "a"],Nothing)]+>          ,qeFrom = [TRSimple [Name "t"]] >          }  > miscOps :: TestItem > miscOps = Group "unaryOperators" $ map (uncurry TestValueExpr) >     [("a in (1,2,3)"->      ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"])+>      ,In True (Iden [Name "a"]) $ InList $ map NumLit ["1","2","3"]) ->     ,("a is null", PostfixOp "is null" (Iden "a"))->     ,("a is not null", PostfixOp "is not null" (Iden "a"))->     ,("a is true", PostfixOp "is true" (Iden "a"))->     ,("a is not true", PostfixOp "is not true" (Iden "a"))->     ,("a is false", PostfixOp "is false" (Iden "a"))->     ,("a is not false", PostfixOp "is not false" (Iden "a"))->     ,("a is unknown", PostfixOp "is unknown" (Iden "a"))->     ,("a is not unknown", PostfixOp "is not unknown" (Iden "a"))->     ,("a is distinct from b", BinOp (Iden "a") "is distinct from"(Iden "b"))+>     ,("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 "a") "is not distinct from" (Iden "b"))+>      ,BinOp (Iden [Name "a"]) [Name "is not distinct from"] (Iden [Name "b"])) ->     ,("a like b", BinOp (Iden "a") "like" (Iden "b"))->     ,("a not like b", BinOp (Iden "a") "not like" (Iden "b"))->     ,("a is similar to b", BinOp (Iden "a") "is similar to" (Iden "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 "a") "is not similar to" (Iden "b"))+>      ,BinOp (Iden [Name "a"]) [Name "is not similar to"] (Iden [Name "b"])) ->     ,("a overlaps b", BinOp (Iden "a") "overlaps" (Iden "b"))+>     ,("a overlaps b", BinOp (Iden [Name "a"]) [Name "overlaps"] (Iden [Name "b"]))   special operators ->     ,("a between b and c", SpecialOp "between" [Iden "a"->                                                ,Iden "b"->                                                ,Iden "c"])+>     ,("a between b and c", SpecialOp [Name "between"] [Iden [Name "a"]+>                                                ,Iden [Name "b"]+>                                                ,Iden [Name "c"]]) ->     ,("a not between b and c", SpecialOp "not between" [Iden "a"->                                                        ,Iden "b"->                                                        ,Iden "c"])+>     ,("a not between b and c", SpecialOp [Name "not between"] [Iden [Name "a"]+>                                                        ,Iden [Name "b"]+>                                                        ,Iden [Name "c"]]) >     ,("(1,2)"->      ,SpecialOp "rowctor" [NumLit "1", NumLit "2"])+>      ,SpecialOp [Name "rowctor"] [NumLit "1", NumLit "2"])   keyword special operators  >     ,("extract(day from t)"->      , SpecialOpK "extract" (Just $ Iden "day") [("from", Iden "t")])+>      , SpecialOpK [Name "extract"] (Just $ Iden [Name "day"]) [("from", Iden [Name "t"])])  >     ,("substring(x from 1 for 2)"->      ,SpecialOpK "substring" (Just $ Iden "x") [("from", NumLit "1")+>      ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("from", NumLit "1") >                                                ,("for", NumLit "2")])  >     ,("substring(x from 1)"->      ,SpecialOpK "substring" (Just $ Iden "x") [("from", NumLit "1")])+>      ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("from", NumLit "1")])  >     ,("substring(x for 2)"->      ,SpecialOpK "substring" (Just $ Iden "x") [("for", NumLit "2")])+>      ,SpecialOpK [Name "substring"] (Just $ Iden [Name "x"]) [("for", NumLit "2")]) ->     ,("substring(x from 1 for 2 collate 'C')"->      ,SpecialOpK "substring" (Just $ Iden "x") [("from", NumLit "1")->                                                ,("for", NumLit "2")->                                                ,("collate", StringLit "C")])+>     ,("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 "position" (Just $ Iden "string1") [("in", Iden "string2")])+>      ,SpecialOpK [Name "position"] (Just $ Iden [Name "string1"]) [("in", Iden [Name "string2"])])  >     ,("CONVERT(char_value USING conversion_char_name)"->      ,SpecialOpK "convert" (Just $ Iden "char_value")->           [("using", Iden "conversion_char_name")])+>      ,SpecialOpK [Name "convert"] (Just $ Iden [Name "char_value"])+>           [("using", Iden [Name "conversion_char_name"])])  >     ,("TRANSLATE(char_value USING translation_name)"->      ,SpecialOpK "translate" (Just $ Iden "char_value")->           [("using", Iden "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 "overlay" (Just $ Iden "string")->           [("placing", Iden "embedded_string")->           ,("from", Iden "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 "overlay" (Just $ Iden "string")->           [("placing", Iden "embedded_string")->           ,("from", Iden "start")->           ,("for", Iden "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@@ -282,118 +282,117 @@   >     ,("trim(from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("both", StringLit " ")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])])  >     ,("trim(leading from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("leading", StringLit " ")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])])  >     ,("trim(trailing from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("trailing", StringLit " ")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])])  >     ,("trim(both from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("both", StringLit " ")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])])   >     ,("trim(leading 'x' from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("leading", StringLit "x")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])])  >     ,("trim(trailing 'y' from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("trailing", StringLit "y")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])]) ->     ,("trim(both 'z' from target_string collate 'C')"->      ,SpecialOpK "trim" Nothing+>     ,("trim(both 'z' from target_string collate C)"+>      ,SpecialOpK [Name "trim"] Nothing >           [("both", StringLit "z")->           ,("from", Iden "target_string")->           ,("collate", StringLit "C")])+>           ,("from", Collate (Iden [Name "target_string"]) [Name "C"])])  >     ,("trim(leading from target_string)"->      ,SpecialOpK "trim" Nothing+>      ,SpecialOpK [Name "trim"] Nothing >           [("leading", StringLit " ")->           ,("from", Iden "target_string")])+>           ,("from", Iden [Name "target_string"])])   >     ]  > aggregates :: TestItem > aggregates = Group "aggregates" $ map (uncurry TestValueExpr)->     [("count(*)",App "count" [Star])+>     [("count(*)",App [Name "count"] [Star])  >     ,("sum(a order by a)"->     ,AggregateApp "sum" Nothing [Iden "a"]->                   [SortSpec (Iden "a") Asc NullsOrderDefault])+>     ,AggregateApp [Name "sum"] SQDefault [Iden [Name "a"]]+>                   [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault] Nothing)  >     ,("sum(all a)"->     ,AggregateApp "sum" (Just All) [Iden "a"] [])+>     ,AggregateApp [Name "sum"] All [Iden [Name "a"]] [] Nothing)  >     ,("count(distinct a)"->     ,AggregateApp "count" (Just Distinct) [Iden "a"] [])+>     ,AggregateApp [Name "count"] Distinct [Iden [Name "a"]] [] Nothing) >     ]  > windowFunctions :: TestItem > windowFunctions = Group "windowFunctions" $ map (uncurry TestValueExpr)->     [("max(a) over ()", WindowApp "max" [Iden "a"] [] [] Nothing)->     ,("count(*) over ()", WindowApp "count" [Star] [] [] Nothing)+>     [("max(a) over ()", WindowApp [Name "max"] [Iden [Name "a"]] [] [] Nothing)+>     ,("count(*) over ()", WindowApp [Name "count"] [Star] [] [] Nothing)  >     ,("max(a) over (partition by b)"->      ,WindowApp "max" [Iden "a"] [Iden "b"] [] Nothing)+>      ,WindowApp [Name "max"] [Iden [Name "a"]] [Iden [Name "b"]] [] Nothing)  >     ,("max(a) over (partition by b,c)"->      ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] [] Nothing)+>      ,WindowApp [Name "max"] [Iden [Name "a"]] [Iden [Name "b"],Iden [Name "c"]] [] Nothing)  >     ,("sum(a) over (order by b)"->      ,WindowApp "sum" [Iden "a"] []->           [SortSpec (Iden "b") Asc NullsOrderDefault] Nothing)+>      ,WindowApp [Name "sum"] [Iden [Name "a"]] []+>           [SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault] Nothing)  >     ,("sum(a) over (order by b desc,c)"->      ,WindowApp "sum" [Iden "a"] []->           [SortSpec (Iden "b") Desc NullsOrderDefault->           ,SortSpec (Iden "c") Asc NullsOrderDefault] Nothing)+>      ,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 "sum" [Iden "a"] [Iden "b"]->           [SortSpec (Iden "c") Asc NullsOrderDefault] Nothing)+>      ,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 "sum" [Iden "a"] [Iden "b"]->       [SortSpec (Iden "c") Asc NullsOrderDefault]+>      ,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 "sum" [Iden "a"] [Iden "b"]->       [SortSpec (Iden "c") Asc NullsOrderDefault]+>      ,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 "sum" [Iden "a"] [Iden "b"]->       [SortSpec (Iden "c") Asc NullsOrderDefault]+>      ,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 "sum" [Iden "a"] [Iden "b"]->       [SortSpec (Iden "c") Asc NullsOrderDefault]+>      ,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 "sum" [Iden "a"] [Iden "b"]->       [SortSpec (Iden "c") Asc NullsOrderDefault]+>      ,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 "sum" [Iden "a"] [Iden "b"]->       [SortSpec (Iden "c") Asc NullsOrderDefault]+>      ,WindowApp [Name "sum"] [Iden [Name "a"]] [Iden [Name "b"]]+>       [SortSpec (Iden [Name "c"]) DirDefault NullsOrderDefault] >       $ Just $ FrameBetween FrameRange >                             (Preceding (NumLit "5")) >                             (Following (NumLit "5")))@@ -402,6 +401,6 @@  > parens :: TestItem > parens = Group "parens" $ map (uncurry TestValueExpr)->     [("(a)", Parens (Iden "a"))->     ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b")))+>     [("(a)", Parens (Iden [Name "a"]))+>     ,("(a + b)", Parens (BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"]))) >     ]