diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Jake Wheat + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jake Wheat nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs new file mode 100644 --- /dev/null +++ b/Language/SQL/SimpleSQL/Fixity.lhs @@ -0,0 +1,174 @@ + +This is the module which deals with fixing up the scalar expression +trees for the operator precedence and associativity (aka 'fixity'). + +It currently uses haskell-src-exts as a hack, the algorithm from there +should be ported to work on these trees natively. Maybe it could be +made generic to use in places other than the scalar expr parser? + +> {-# LANGUAGE TupleSections #-} +> module Language.SQL.SimpleSQL.Fixity +> (fixFixities +> ,Fixity(..) +> ,Assoc(..) +> ,infixl_ +> ,infixr_ +> ,infix_ +> ) where + +> import qualified Language.Haskell.Exts.Syntax as HSE +> import qualified Language.Haskell.Exts.Fixity as HSE +> import Control.Monad.Identity +> import Control.Applicative +> import Data.Maybe + +> import Language.SQL.SimpleSQL.Syntax + +> data Fixity = Fixity String --name of op +> Assoc +> deriving (Eq,Show) + +> data Assoc = AssocLeft | AssocRight | AssocNone +> deriving (Eq,Show) + +> infixl_ :: [String] -> [Fixity] +> infixl_ = map (`Fixity` AssocLeft) + +> infixr_ :: [String] -> [Fixity] +> infixr_ = map (`Fixity` AssocRight) + +> infix_ :: [String] -> [Fixity] +> infix_ = map (`Fixity` AssocNone) + +> toHSEFixity :: [[Fixity]] -> [HSE.Fixity] +> toHSEFixity fs = +> let fs' = zip [0..] $ reverse fs +> in concatMap f fs' +> where +> f :: (Int, [Fixity]) -> [HSE.Fixity] +> f (n,fs') = flip concatMap fs' $ \(Fixity nm assoc) -> +> case assoc of +> AssocLeft -> HSE.infixl_ n [nm] +> AssocRight -> HSE.infixr_ n [nm] +> AssocNone -> HSE.infix_ n [nm] + +fix the fixities in the given scalar expr. All the expressions to be +fixed should be left associative and equal precedence to be fixed +correctly. It doesn't descend into query expressions in subqueries and +the scalar expressions they contain. + +TODO: get it to work on prefix and postfix unary operators also maybe +it should work on some of the other syntax (such as in). + +> fixFixities :: [[Fixity]] -> ScalarExpr -> ScalarExpr +> fixFixities fs se = +> runIdentity $ toSql <$> HSE.applyFixities (toHSEFixity fs) (toHaskell se) + +Now have to convert all our scalar exprs to haskell and back again. +Have to come up with a recipe for each ctor. Only continue if you have +a strong stomach. Probably would have been less effort to just write +the fixity code. + +> toHaskell :: ScalarExpr -> HSE.Exp +> toHaskell e = case e of +> BinOp e0 op e1 -> HSE.InfixApp +> (toHaskell e0) +> (HSE.QVarOp $ sym op) +> (toHaskell e1) +> Iden {} -> str ('v':show e) +> StringLit {} -> str ('v':show e) +> NumLit {} -> str ('v':show e) +> App n es -> HSE.App (var ('f':n)) $ ltoh es +> Parens e0 -> HSE.Paren $ toHaskell e0 +> IntervalLit {} -> str ('v':show e) +> Iden2 {} -> str ('v':show e) +> Star -> str ('v':show e) +> Star2 {} -> str ('v':show e) +> AggregateApp nm d es od -> +> HSE.App (var ('a':nm)) +> $ HSE.List [str $ show (d,map snd od) +> ,HSE.List $ map toHaskell es +> ,HSE.List $ map (toHaskell . fst) od] +> WindowApp nm es pb od -> +> HSE.App (var ('w':nm)) +> $ HSE.List [str $ show (map snd od) +> ,HSE.List $ map toHaskell es +> ,HSE.List $ map toHaskell pb +> ,HSE.List $ map (toHaskell . fst) od] +> PrefixOp nm e0 -> +> HSE.App (HSE.Var $ sym nm) (toHaskell e0) +> PostfixOp nm e0 -> +> HSE.App (HSE.Var $ sym ('p':nm)) (toHaskell e0) +> SpecialOp nm es -> +> HSE.App (var ('s':nm)) $ HSE.List $ map toHaskell es +> -- map the two maybes to lists with either 0 or 1 element +> Case v ts el -> HSE.App (var "$case") +> (HSE.List [ltoh $ maybeToList v +> ,HSE.List $ map (ltoh . (\(a,b) -> [a,b])) ts +> ,ltoh $ maybeToList el]) +> Cast e0 tn -> HSE.App (str ('c':show tn)) $ toHaskell e0 +> CastOp {} -> str ('v':show e) +> SubQueryExpr {} -> str ('v': show e) +> In b e0 (InList l) -> +> HSE.App (str ('i':show b)) +> $ HSE.List [toHaskell e0, HSE.List $ map toHaskell l] +> In b e0 i -> HSE.App (str ('j':show (b,i))) $ toHaskell e0 +> where +> ltoh = HSE.List . map toHaskell +> str = HSE.Lit . HSE.String +> var = HSE.Var . HSE.UnQual . HSE.Ident +> sym = HSE.UnQual . HSE.Symbol + + +> toSql :: HSE.Exp -> ScalarExpr +> toSql e = case e of + + +> HSE.InfixApp e0 (HSE.QVarOp (HSE.UnQual (HSE.Symbol n))) e1 -> +> BinOp (toSql e0) n (toSql e1) +> HSE.Lit (HSE.String ('v':l)) -> read l +> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('f':i)))) +> (HSE.List es) -> App i $ map toSql es +> HSE.Paren e0 -> Parens $ toSql e0 +> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('a':i)))) +> (HSE.List [HSE.Lit (HSE.String vs) +> ,HSE.List es +> ,HSE.List od]) -> +> let (d,dir) = read vs +> in AggregateApp i d (map toSql es) +> $ zip (map toSql od) dir +> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('w':i)))) +> (HSE.List [HSE.Lit (HSE.String vs) +> ,HSE.List es +> ,HSE.List pb +> ,HSE.List od]) -> +> let dir = read vs +> in WindowApp i (map toSql es) +> (map toSql pb) +> $ zip (map toSql od) dir +> HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol ('p':nm)))) e0 -> +> PostfixOp nm $ toSql e0 +> HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol nm))) e0 -> +> PrefixOp nm $ toSql e0 +> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('s':nm)))) (HSE.List es) -> +> SpecialOp nm $ map toSql es +> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case"))) +> (HSE.List [v,ts,el]) -> +> Case (ltom v) (pairs ts) (ltom el) +> HSE.App (HSE.Lit (HSE.String ('c':nm))) e0 -> +> Cast (toSql e0) (read nm) +> HSE.App (HSE.Lit (HSE.String ('i':nm))) +> (HSE.List [e0, HSE.List es]) -> +> In (read nm) (toSql e0) (InList $ map toSql es) +> HSE.App (HSE.Lit (HSE.String ('j':nm))) e0 -> +> let (b,sq) = read nm +> in In b (toSql e0) sq +> _ -> err e +> where +> ltom (HSE.List []) = Nothing +> ltom (HSE.List [ex]) = Just $ toSql ex +> ltom ex = err ex +> pairs (HSE.List l) = map (\(HSE.List [a,b]) -> (toSql a, toSql b)) l +> pairs ex = err ex +> err :: Show a => a -> e +> err a = error $ "simple-sql-parser: internal fixity error " ++ show a diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs new file mode 100644 --- /dev/null +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -0,0 +1,793 @@ + +> -- | This is the module with the parser functions. +> module Language.SQL.SimpleSQL.Parser +> (parseQueryExpr +> ,parseScalarExpr +> ,parseQueryExprs +> ,ParseError(..)) where + +> import Control.Monad.Identity +> import Control.Applicative hiding (many, (<|>), optional) +> import Data.Maybe +> import Data.Char +> import Text.Parsec hiding (ParseError) +> import qualified Text.Parsec as P + +> import Language.SQL.SimpleSQL.Syntax +> import Language.SQL.SimpleSQL.Fixity + +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 to use in errors +> -> String -- ^ the SQL source to parse +> -> Either ParseError QueryExpr +> parseQueryExpr = wrapParse topLevelQueryExpr + +> -- | Parses a list of query exprs, 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 to use in errors +> -> String -- ^ the SQL source to parse +> -> Either ParseError [QueryExpr] +> parseQueryExprs = wrapParse queryExprs + +> -- | Parses a scalar expression. +> parseScalarExpr :: FilePath -- ^ filename to use in errors +> -> Maybe (Int,Int) -- ^ line number and column number to use in errors +> -> String -- ^ the SQL source to parse +> -> Either ParseError ScalarExpr +> parseScalarExpr = wrapParse scalarExpr + +This helper function takes the parser given and: + +sets the position when parsing +automatically skips leading whitespace +checks the parser parses all the input using eof +converts the error return to the nice wrapper + +> wrapParse :: P 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) + +------------------------------------------------ + +> type P a = ParsecT String () Identity a + += scalar expressions + +== literals + +See the stringLiteral lexer below for notes on string literal syntax. + +> estring :: P ScalarExpr +> estring = StringLit <$> stringLiteral + +> number :: P ScalarExpr +> number = NumLit <$> numberLiteral + +parse SQL interval literals, something like +interval '5' day (3) +or +interval '5' month + +> interval :: P ScalarExpr +> interval = try (keyword_ "interval") >> +> IntervalLit +> <$> stringLiteral +> <*> identifierString +> <*> optionMaybe (try $ parens integerLiteral) + +> literal :: P ScalarExpr +> literal = number <|> estring <|> interval + +== identifiers + +Uses the identifierString 'lexer'. See this function for notes on identifiers. + +> identifier :: P ScalarExpr +> identifier = Iden <$> identifierString + +Identifier with one dot in it. This should be extended to any amount +of dots. + +> dottedIden :: P ScalarExpr +> dottedIden = Iden2 <$> identifierString +> <*> (symbol "." *> identifierString) + +== star + +used in select *, select x.*, and agg(*) variations. + +> star :: P ScalarExpr +> star = choice [Star <$ symbol "*" +> ,Star2 <$> (identifierString <* symbol "." <* symbol "*")] + +== function application, aggregates and windows + +this represents anything which syntactically looks like regular C +function application: an identifier, parens with comma sep scalar +expression arguments. + +The parsing for the aggregate extensions is here as well: + +aggregate([all|distinct] args [order by orderitems]) + +> aggOrApp :: P ScalarExpr +> aggOrApp = +> makeApp +> <$> identifierString +> <*> parens ((,,) <$> try duplicates +> <*> choice [(:[]) <$> try star +> ,commaSep scalarExpr'] +> <*> try (optionMaybe orderBy)) +> where +> makeApp i (Nothing,es,Nothing) = App i es +> makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od) + +> duplicates :: P (Maybe Duplicates) +> 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 :: ScalarExpr -> P ScalarExpr +> windowSuffix (App f es) = +> try (keyword_ "over") +> *> parens (WindowApp f es +> <$> option [] partitionBy +> <*> option [] orderBy) +> where +> partitionBy = try (keyword_ "partition") >> +> keyword_ "by" >> commaSep1 scalarExpr' +> windowSuffix _ = fail "" + +> app :: P ScalarExpr +> app = aggOrApp >>= optionSuffix windowSuffix + +== case expression + +> scase :: P ScalarExpr +> scase = +> Case <$> (try (keyword_ "case") *> optionMaybe (try scalarExpr')) +> <*> many1 swhen +> <*> optionMaybe (try (keyword_ "else") *> scalarExpr') +> <* keyword_ "end" +> where +> swhen = keyword_ "when" *> +> ((,) <$> scalarExpr' <*> (keyword_ "then" *> scalarExpr')) + +== 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 :: P ScalarExpr +> cast = parensCast <|> prefixCast +> where +> parensCast = try (keyword_ "cast") >> +> parens (Cast <$> scalarExpr' +> <*> (keyword_ "as" *> typeName)) +> prefixCast = try (CastOp <$> typeName +> <*> stringLiteral) + +extract(id from expr) + +> extract :: P ScalarExpr +> extract = try (keyword_ "extract") >> +> parens (makeOp <$> identifierString +> <*> (keyword_ "from" *> scalarExpr')) +> where makeOp n e = SpecialOp "extract" [Iden n, e] + +substring(x from expr to expr) + +todo: also support substring(x from expr) + +> substring :: P ScalarExpr +> substring = try (keyword_ "substring") >> +> parens (makeOp <$> scalarExpr' +> <*> (keyword_ "from" *> scalarExpr') +> <*> (keyword_ "for" *> scalarExpr') +> ) +> where makeOp a b c = SpecialOp "substring" [a,b,c] + +in: two variations: +a in (expr0, expr1, ...) +a in (queryexpr) + +> inSuffix :: ScalarExpr -> P ScalarExpr +> inSuffix e = +> In <$> inty +> <*> return e +> <*> parens (choice +> [InQueryExpr <$> queryExpr +> ,InList <$> commaSep1 scalarExpr']) +> where +> inty = try $ choice [True <$ keyword_ "in" +> ,False <$ keyword_ "not" <* keyword_ "in"] + +between: +expr between expr and expr + +There is a complication when parsing between - when parsing the second +expression it is ambiguous when you hit an 'and' whether it is a +binary operator or part of the between. This code follows what +postgres does, which might be standard across SQL implementations, +which is that you can't have a binary and operator in the middle +expression in a between unless it is wrapped in parens. The 'bExpr +parsing' is used to create alternative scalar expression parser which +is identical to the normal one expect it doesn't recognise the binary +and operator. This is the call to scalarExpr'' True. + +> betweenSuffix :: ScalarExpr -> P ScalarExpr +> betweenSuffix e = +> makeOp <$> opName +> <*> return e +> <*> scalarExpr'' True +> <*> (keyword_ "and" *> scalarExpr'' True) +> where +> opName = try $ choice +> ["between" <$ keyword_ "between" +> ,"not between" <$ keyword_ "not" <* keyword_ "between"] +> makeOp n a b c = SpecialOp n [a,b,c] + +subquery expression: +[exists|all|any|some] (queryexpr) + +> subquery :: P ScalarExpr +> 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 :: P TypeName +> typeName = choice +> [TypeName "double precision" +> <$ try (keyword_ "double" <* keyword_ "precision") +> ,TypeName "character varying" +> <$ try (keyword_ "character" <* keyword_ "varying") +> ,TypeName <$> identifierString] + +== scalar parens + +> sparens :: P ScalarExpr +> sparens = Parens <$> parens scalarExpr' + + +== 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). + +First, the list of the regulars operators split by operator type +(prefix, postfix, binary) and by symbol/single keyword/ multiple +keyword. + +> binOpSymbolNames :: [String] +> binOpSymbolNames = +> ["=", "<=", ">=", "!=", "<>", "<", ">" +> ,"*", "/", "+", "-" +> ,"||"] + +> binOpKeywordNames :: [String] +> binOpKeywordNames = ["and", "or", "like", "overlaps"] + +> binOpMultiKeywordNames :: [[String]] +> binOpMultiKeywordNames = map words +> ["not like" +> ,"is similar to" +> ,"is not similar to" +> ,"is distinct from" +> ,"is not distinct from"] + +used for between parsing + +> binOpKeywordNamesNoAnd :: [String] +> binOpKeywordNamesNoAnd = filter (/="and") binOpKeywordNames + +There aren't any multi keyword prefix operators currently supported. + +> prefixUnOpKeywordNames :: [String] +> prefixUnOpKeywordNames = ["not"] + +> prefixUnOpSymbolNames :: [String] +> prefixUnOpSymbolNames = ["+", "-"] + +There aren't any single keyword postfix operators currently +supported. Maybe all these 'is's can be left factored? + +> postfixOpKeywords :: [String] +> postfixOpKeywords = ["is null" +> ,"is not null" +> ,"is true" +> ,"is not true" +> ,"is false" +> ,"is not false" +> ,"is unknown" +> ,"is not unknown"] + +The parsers: + +> prefixUnaryOp :: P ScalarExpr +> prefixUnaryOp = +> PrefixOp <$> opSymbol <*> scalarExpr' +> where +> opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames +> ++ map (try . keyword) prefixUnOpKeywordNames) + +TODO: the handling of multikeyword args is different in +postfixopsuffix and binaryoperatorsuffix. It should be the same in +both cases + +> postfixOpSuffix :: ScalarExpr -> P ScalarExpr +> postfixOpSuffix e = +> try $ choice $ map makeOp opPairs +> where +> opPairs = flip map postfixOpKeywords $ \o -> (o, words o) +> makeOp (o,ws) = try $ PostfixOp o e <$ keywords_ ws +> keywords_ = try . mapM_ keyword_ + +All the binary operators are parsed as same precedence and left +associativity. This is fixed with a separate pass over the AST. + +> binaryOperatorSuffix :: Bool -> ScalarExpr -> P ScalarExpr +> binaryOperatorSuffix bExpr e0 = +> BinOp e0 <$> opSymbol <*> factor +> where +> opSymbol = choice +> (map (try . symbol) binOpSymbolNames +> ++ map (try . keywords) binOpMultiKeywordNames +> ++ map (try . keyword) +> (if bExpr +> then binOpKeywordNamesNoAnd +> else binOpKeywordNames)) +> keywords ks = unwords <$> mapM keyword ks + +> sqlFixities :: [[Fixity]] +> sqlFixities = highPrec ++ defaultPrec ++ lowPrec +> where +> allOps = binOpSymbolNames ++ binOpKeywordNames +> ++ map unwords binOpMultiKeywordNames +> ++ prefixUnOpKeywordNames ++ prefixUnOpSymbolNames +> ++ postfixOpKeywords +> -- these are the ops with the highest precedence in order +> highPrec = [infixl_ ["*","/"] +> ,infixl_ ["+", "-"] +> ,infixl_ ["<=",">=","!=","<>","||","like"] +> ] +> -- these are the ops with the lowest precedence in order +> lowPrec = [infix_ ["<",">"] +> ,infixr_ ["="] +> ,infixr_ ["not"] +> ,infixl_ ["and"] +> ,infixl_ ["or"]] +> already = concatMap (map fName) highPrec +> ++ concatMap (map fName) lowPrec +> -- all the other ops have equal precedence and go between the +> -- high and low precedence ops +> defaultPrecOps = filter (`notElem` already) allOps +> -- almost correct, have to do some more work to +> -- get the associativity correct for these operators +> defaultPrec = [infixl_ defaultPrecOps] +> fName (Fixity n _) = n + + +== scalar expressions + +TODO: +left factor stuff which starts with identifier + +This parses most of the scalar exprs. I'm not sure if factor is the +correct terminology here. 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. + +> factor :: P ScalarExpr +> factor = choice [literal +> ,scase +> ,cast +> ,extract +> ,substring +> ,subquery +> ,prefixUnaryOp +> ,try app +> ,try dottedIden +> ,identifier +> ,sparens] + +putting the factor together with the extra bits + +> scalarExpr'' :: Bool -> P ScalarExpr +> scalarExpr'' bExpr = factor >>= trysuffix +> where +> trysuffix e = try (suffix e) <|> return e +> suffix e0 = choice +> [binaryOperatorSuffix bExpr e0 +> ,inSuffix e0 +> ,betweenSuffix e0 +> ,postfixOpSuffix e0 +> ] >>= trysuffix + +Wrapper for non 'bExpr' parsing. See the between parser for +explanation. + +> scalarExpr' :: P ScalarExpr +> scalarExpr' = scalarExpr'' False + +The scalarExpr wrapper. The idea is that directly nested scalar +expressions use the scalarExpr' parser, then other code uses the +scalarExpr parser and then everyone gets the fixity fixes and it's +easy to ensure that this fix is only applied once to each scalar +expression tree (for efficiency and code clarity). + +> scalarExpr :: P ScalarExpr +> scalarExpr = +> choice [try star +> ,fixFixities sqlFixities <$> scalarExpr'] + +------------------------------------------------- + += query expressions + +== select lists + +> selectItem :: P (Maybe String, ScalarExpr) +> selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try alias) +> where alias = optional (try (keyword_ "as")) *> identifierString + +> selectList :: P [(Maybe String,ScalarExpr)] +> 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 :: P [TableRef] +> from = try (keyword_ "from") *> commaSep1 tref +> where +> tref = nonJoinTref >>= optionSuffix joinTrefSuffix +> nonJoinTref = choice [try (TRQueryExpr <$> parens queryExpr) +> ,TRParens <$> parens tref +> ,TRSimple <$> identifierString] +> >>= optionSuffix aliasSuffix +> aliasSuffix j = +> let tableAlias = optional (try $ keyword_ "as") *> identifierString +> columnAliases = optionMaybe $ try $ parens +> $ commaSep1 identifierString +> in option j (TRAlias j <$> try tableAlias <*> try columnAliases) +> joinTrefSuffix t = (do +> nat <- option False $ try (True <$ try (keyword_ "natural")) +> TRJoin t <$> joinType +> <*> nonJoinTref +> <*> optionMaybe (joinCondition nat)) +> >>= optionSuffix joinTrefSuffix +> joinType = 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" +> joinCondition nat = +> choice [guard nat >> return JoinNatural +> ,try (keyword_ "on") >> +> JoinOn <$> scalarExpr +> ,try (keyword_ "using") >> +> JoinUsing <$> parens (commaSep1 identifierString) +> ] + +== 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). + +> keywordScalarExpr :: String -> P ScalarExpr +> keywordScalarExpr k = try (keyword_ k) *> scalarExpr + +> swhere :: P ScalarExpr +> swhere = keywordScalarExpr "where" + +> sgroupBy :: P [ScalarExpr] +> sgroupBy = try (keyword_ "group") +> *> keyword_ "by" +> *> commaSep1 scalarExpr + +> having :: P ScalarExpr +> having = keywordScalarExpr "having" + +> orderBy :: P [(ScalarExpr,Direction)] +> orderBy = try (keyword_ "order") *> keyword_ "by" *> commaSep1 ob +> where +> ob = (,) <$> scalarExpr +> <*> option Asc (choice [Asc <$ keyword_ "asc" +> ,Desc <$ keyword_ "desc"]) + +> limit :: P ScalarExpr +> limit = keywordScalarExpr "limit" + +> offset :: P ScalarExpr +> offset = keywordScalarExpr "offset" + +== common table expressions + +> with :: P QueryExpr +> with = try (keyword_ "with") >> +> With <$> commaSep1 withQuery <*> queryExpr +> where +> withQuery = +> (,) <$> (identifierString <* optional (try $ keyword_ "as")) +> <*> parens queryExpr + +== query expression + +This parser parses any query expression variant: normal select, cte, +and union, etc.. + +> queryExpr :: P QueryExpr +> queryExpr = +> choice [with +> ,select >>= optionSuffix queryExprSuffix] +> where +> select = try (keyword_ "select") >> +> Select +> <$> (fromMaybe All <$> duplicates) +> <*> selectList +> <*> option [] from +> <*> optionMaybe swhere +> <*> option [] sgroupBy +> <*> optionMaybe having +> <*> option [] orderBy +> <*> optionMaybe limit +> <*> optionMaybe offset + +> queryExprSuffix :: QueryExpr -> P 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 :: P 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 :: P [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 -> P String +> symbol s = string s +> -- <* notFollowedBy (oneOf "+-/*<>=!|") +> <* whiteSpace + +> symbol_ :: String -> P () +> symbol_ s = symbol s *> return () + +> keyword :: String -> P String +> keyword s = (map toLower <$> string s) +> <* notFollowedBy (char '_' <|> alphaNum) +> <* whiteSpace + +> keyword_ :: String -> P () +> 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. + +> identifierString :: P String +> identifierString = do +> s <- (:) <$> letterOrUnderscore +> <*> many letterDigitOrUnderscore <* whiteSpace +> guard (s `notElem` blacklist) +> return s +> where +> letterOrUnderscore = char '_' <|> letter +> letterDigitOrUnderscore = char '_' <|> alphaNum + +> blacklist :: [String] +> blacklist = +> ["select", "as", "from", "where", "having", "group", "order" +> ,"limit", "offset" +> ,"inner", "left", "right", "full", "natural", "join" +> ,"cross", "on", "using" +> ,"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. + +String literals: limited at the moment, no escaping \' or other +variations. + +> stringLiteral :: P String +> stringLiteral = char '\'' *> manyTill anyChar (symbol_ "'") + +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 :: P 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 :: P Int +> integerLiteral = read <$> many1 digit <* whiteSpace + +whitespace parser which skips comments also + +> whiteSpace :: P () +> 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 -> P a) -> a -> P a +> optionSuffix p a = option a (p a) + +> parens :: P a -> P a +> parens = between (symbol_ "(") (symbol_ ")") + +> commaSep :: P a -> P [a] +> commaSep = (`sepBy` symbol_ ",") + + +> commaSep1 :: P a -> P [a] +> commaSep1 = (`sepBy1` symbol_ ",") + +-------------------------------------------- + += helper functions + +> setPos :: Maybe (Int,Int) -> P () +> 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 diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs new file mode 100644 --- /dev/null +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -0,0 +1,233 @@ + +> -- | These is the pretty printing functions, which produce SQL +> -- source from ASTs. The code attempts to format the output in a +> -- readable way. +> module Language.SQL.SimpleSQL.Pretty +> (prettyQueryExpr +> ,prettyScalarExpr +> ,prettyQueryExprs +> ) where + +> import Language.SQL.SimpleSQL.Syntax +> import Text.PrettyPrint +> import Data.Maybe + +> -- | Convert a query expr ast to concrete syntax. +> prettyQueryExpr :: QueryExpr -> String +> prettyQueryExpr = render . queryExpr + +> -- | Convert a scalar expr ast to concrete syntax. +> prettyScalarExpr :: ScalarExpr -> String +> prettyScalarExpr = render . scalarExpr + +> -- | Convert a list of query exprs to concrete syntax. A semi colon +> -- is inserted after each query expr. +> prettyQueryExprs :: [QueryExpr] -> String +> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr) + += scalar expressions + +> scalarExpr :: ScalarExpr -> Doc +> scalarExpr (StringLit s) = quotes $ text s +> scalarExpr (NumLit s) = text s +> scalarExpr (IntervalLit v u p) = +> text "interval" <+> quotes (text v) +> <+> text u +> <+> maybe empty (parens . text . show ) p +> scalarExpr (Iden i) = text i +> scalarExpr (Iden2 q i) = text q <> text "." <> text i +> scalarExpr Star = text "*" +> scalarExpr (Star2 q) = text q <> text "." <> text "*" + +> scalarExpr (App f es) = text f <> parens (commaSep (map scalarExpr es)) + +> scalarExpr (AggregateApp f d es od) = +> text f +> <> parens ((case d of +> Just Distinct -> text "distinct" +> Just All -> text "all" +> Nothing -> empty) +> <+> commaSep (map scalarExpr es) +> <+> orderBy od) + +> scalarExpr (WindowApp f es pb od) = +> text f <> parens (commaSep $ map scalarExpr es) +> <+> text "over" +> <+> parens ((case pb of +> [] -> empty +> _ -> text "partition by" +> <+> nest 13 (commaSep $ map scalarExpr pb)) +> <+> orderBy od) + +> scalarExpr (SpecialOp nm [a,b,c]) | nm `elem` ["between", "not between"] = +> sep [scalarExpr a +> ,text nm <+> scalarExpr b +> ,nest (length nm + 1) +> $ text "and" <+> scalarExpr c] + +> scalarExpr (SpecialOp "extract" [a,n]) = +> text "extract" <> parens (scalarExpr a +> <+> text "from" +> <+> scalarExpr n) + +> scalarExpr (SpecialOp "substring" [a,s,e]) = +> text "substring" <> parens (scalarExpr a +> <+> text "from" +> <+> scalarExpr s +> <+> text "for" +> <+> scalarExpr e) + +> scalarExpr (SpecialOp nm es) = +> text nm <+> parens (commaSep $ map scalarExpr es) + +> scalarExpr (PrefixOp f e) = text f <+> scalarExpr e +> scalarExpr (PostfixOp f e) = scalarExpr e <+> text f +> scalarExpr e@(BinOp _ op _) | op `elem` ["and", "or"] = +> -- special case for and, or, get all the ands so we can vcat them +> -- nicely +> case ands e of +> (e':es) -> vcat (scalarExpr e' +> : map ((text op <+>) . scalarExpr) es) +> [] -> empty -- shouldn't be possible +> where +> ands (BinOp a op' b) | op == op' = ands a ++ ands b +> ands x = [x] +> scalarExpr (BinOp e0 f e1) = +> scalarExpr e0 <+> text f <+> scalarExpr e1 + +> scalarExpr (Case t ws els) = +> sep $ [text "case" <+> maybe empty scalarExpr t] +> ++ map w ws +> ++ maybeToList (fmap e els) +> ++ [text "end"] +> where +> w (t0,t1) = +> text "when" <+> nest 5 (scalarExpr t0) +> <+> text "then" <+> nest 5 (scalarExpr t1) +> e el = text "else" <+> nest 5 (scalarExpr el) +> scalarExpr (Parens e) = parens $ scalarExpr e +> scalarExpr (Cast e (TypeName tn)) = +> text "cast" <> parens (sep [scalarExpr e +> ,text "as" +> ,text tn]) + +> scalarExpr (CastOp (TypeName tn) s) = +> text tn <+> quotes (text s) + +> scalarExpr (SubQueryExpr ty qe) = +> (case ty of +> SqSq -> empty +> SqExists -> text "exists" +> SqAll -> text "all" +> SqSome -> text "some" +> SqAny -> text "any" +> ) <+> parens (queryExpr qe) + +> scalarExpr (In b se x) = +> scalarExpr se <+> +> (if b then empty else text "not") +> <+> text "in" +> <+> parens (nest (if b then 3 else 7) $ +> case x of +> InList es -> commaSep $ map scalarExpr es +> InQueryExpr qe -> queryExpr qe) + += query expressions + +> queryExpr :: QueryExpr -> Doc +> queryExpr (Select d sl fr wh gb hv od lm off) = +> sep [text "select" +> ,case d of +> All -> empty +> Distinct -> text "distinct" +> ,nest 7 $ sep [selectList sl] +> ,from fr +> ,maybeScalarExpr "where" wh +> ,grpBy gb +> ,maybeScalarExpr "having" hv +> ,orderBy od +> ,maybeScalarExpr "limit" lm +> ,maybeScalarExpr "offset" off +> ] +> queryExpr (CombineQueryExpr q1 ct d c q2) = +> sep [queryExpr q1 +> ,text (case ct of +> Union -> "union" +> Intersect -> "intersect" +> Except -> "except") +> <+> case d of +> All -> empty +> Distinct -> text "distinct" +> <+> case c of +> Corresponding -> text "corresponding" +> Respectively -> empty +> ,queryExpr q2] +> queryExpr (With withs qe) = +> text "with" +> <+> vcat [nest 5 +> (vcat $ punctuate comma $ flip map withs $ \(n,q) -> +> text n <+> text "as" <+> parens (queryExpr q)) +> ,queryExpr qe] + +> selectList :: [(Maybe String, ScalarExpr)] -> Doc +> selectList is = commaSep $ map si is +> where +> si (al,e) = scalarExpr e <+> maybe empty alias al +> alias al = text "as" <+> text al + +> from :: [TableRef] -> Doc +> from [] = empty +> from ts = +> sep [text "from" +> ,nest 5 $ vcat $ punctuate comma $ map tr ts] +> where +> tr (TRSimple t) = text t +> tr (TRAlias t a cs) = +> sep [tr t +> ,text "as" <+> text a +> <+> maybe empty (parens . commaSep . map text) cs] +> tr (TRParens t) = parens $ tr t +> tr (TRQueryExpr q) = parens $ queryExpr q +> tr (TRJoin t0 jt t1 jc) = +> sep [tr t0 +> ,joinText jt jc <+> tr t1 +> ,joinCond jc] +> joinText jt jc = +> sep [case jc of +> Just JoinNatural -> text "natural" +> _ -> empty +> ,case jt of +> JInner -> text "inner" +> JLeft -> text "left" +> JRight -> text "right" +> JFull -> text "full" +> JCross -> text "cross" +> ,text "join"] +> joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e +> joinCond (Just (JoinUsing es)) = +> text "using" <+> parens (commaSep $ map text es) +> joinCond Nothing = empty +> joinCond (Just JoinNatural) = empty + +> maybeScalarExpr :: String -> Maybe ScalarExpr -> Doc +> maybeScalarExpr k = maybe empty +> (\e -> sep [text k +> ,nest (length k + 1) $ scalarExpr e]) + +> grpBy :: [ScalarExpr] -> Doc +> grpBy [] = empty +> grpBy gs = sep [text "group by" +> ,nest 9 $ commaSep $ map scalarExpr gs] + +> orderBy :: [(ScalarExpr,Direction)] -> Doc +> orderBy [] = empty +> orderBy os = sep [text "order by" +> ,nest 9 $ commaSep $ map f os] +> where +> f (e,Asc) = scalarExpr e +> f (e,Desc) = scalarExpr e <+> text "desc" + += utils + +> commaSep :: [Doc] -> Doc +> commaSep ds = sep $ punctuate comma ds diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs new file mode 100644 --- /dev/null +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -0,0 +1,210 @@ + +> -- | The AST for SQL queries +> module Language.SQL.SimpleSQL.Syntax +> (-- * Scalar expressions +> ScalarExpr(..) +> ,TypeName(..) +> ,Duplicates(..) +> ,Direction(..) +> ,InThing(..) +> ,SubQueryExprType(..) +> -- * Query expressions +> ,QueryExpr(..) +> ,makeSelect +> ,CombineOp(..) +> ,Corresponding(..) +> -- ** From +> ,TableRef(..) +> ,JoinType(..) +> ,JoinCondition(..) +> ) where + +> -- | Represents a scalar expression +> data ScalarExpr +> = -- | a numeric literal optional decimal point, e+- +> -- integral exponent, e.g +> -- +> -- * 10 +> -- +> -- * 10. +> -- +> -- * .1 +> -- +> -- * 10.1 +> -- +> -- * 1e5 +> -- +> -- * 12.34e-6 +> NumLit String +> -- | string literal, currently only basic strings between +> -- single quotes without escapes (no single quotes in strings +> -- then) +> | StringLit String +> -- | text of interval literal, units of interval precision, +> -- e.g. interval 3 days (3) +> | IntervalLit String String (Maybe Int) +> -- | identifier without dots +> | Iden String +> -- | identifier with one dot +> | Iden2 String String +> -- | star +> | Star +> -- | star with qualifier, e.g t.* +> | Star2 String +> -- | function application (anything that looks like c style +> -- function application syntactically) +> | App String [ScalarExpr] +> -- | aggregate application, which adds distinct or all, and +> -- order by, to regular function application +> | AggregateApp String (Maybe Duplicates) +> [ScalarExpr] +> [(ScalarExpr,Direction)] +> -- | window application, which adds over (partition by a order +> -- by b) to regular function application. Explicit frames are +> -- not currently supported +> | WindowApp String [ScalarExpr] [ScalarExpr] [(ScalarExpr,Direction)] +> -- | Infix binary operators. This is used for symbol operators +> -- (a + b), keyword operators (a and b) and multiple keyword +> -- operators (a is similar to b) +> | BinOp ScalarExpr String ScalarExpr +> -- | Prefix unary operators. This is used for symbol +> -- operators, keyword operators and multiple keyword operators +> | PrefixOp String ScalarExpr +> -- | Postfix unary operators. This is used for symbol +> -- operators, keyword operators and multiple keyword operators +> | PostfixOp String ScalarExpr +> -- | Used for ternary, mixfix and other non orthodox +> -- operators, including the function looking calls which use +> -- keywords instead of commas to separate the arguments, +> -- e.g. substring(t from 1 to 5) +> | SpecialOp String [ScalarExpr] +> -- | case expression. both flavours supported. Multiple +> -- condition when branches not currently supported (case when +> -- a=4,b=5 then x end) +> | Case (Maybe ScalarExpr) -- test value +> [(ScalarExpr,ScalarExpr)] -- when branches +> (Maybe ScalarExpr) -- else value +> | Parens ScalarExpr +> -- | cast(a as typename) +> | Cast ScalarExpr TypeName +> -- | prefix 'typed literal', e.g. int '42' +> | CastOp TypeName String +> -- | exists, all, any, some subqueries +> | SubQueryExpr SubQueryExprType QueryExpr +> -- | in list literal and in subquery, if the bool is false it +> -- means not in was used ('a not in (1,2)') +> | In Bool ScalarExpr InThing +> deriving (Eq,Show,Read) + +> -- | Represents a type name, used in casts. +> data TypeName = TypeName String deriving (Eq,Show,Read) + + +> -- | Used for 'expr in (scalar expression list)', and 'expr in +> -- (subquery)' syntax +> data InThing = InList [ScalarExpr] +> | InQueryExpr QueryExpr +> deriving (Eq,Show,Read) + +> -- | A subquery in a scalar expression +> data SubQueryExprType +> = -- | exists (query expr) +> SqExists +> -- | a scalar subquery +> | SqSq +> -- | all (query expr) +> | SqAll +> -- | some (query expr) +> | SqSome +> -- | any (query expr) +> | SqAny +> deriving (Eq,Show,Read) + +> -- | Represents a query expression, which can be: +> -- +> -- * a regular select; +> -- +> -- * a set operator (union, except, intersect); +> -- +> -- * a common table expression (with); +> -- +> -- * a values expression (not yet supported); +> -- +> -- * or the table syntax - 'table t', shorthand for 'select * from +> -- t' (not yet supported). +> data QueryExpr +> = Select +> {qeDuplicates :: Duplicates +> ,qeSelectList :: [(Maybe String,ScalarExpr)] +> -- ^ the column aliases and the expressions +> ,qeFrom :: [TableRef] +> ,qeWhere :: Maybe ScalarExpr +> ,qeGroupBy :: [ScalarExpr] +> ,qeHaving :: Maybe ScalarExpr +> ,qeOrderBy :: [(ScalarExpr,Direction)] +> ,qeLimit :: Maybe ScalarExpr +> ,qeOffset :: Maybe ScalarExpr +> } +> | CombineQueryExpr +> {qe1 :: QueryExpr +> ,qeCombOp :: CombineOp +> ,qeDuplicates :: Duplicates +> ,qeCorresponding :: Corresponding +> ,qe2 :: QueryExpr +> } +> | With [(String,QueryExpr)] QueryExpr +> deriving (Eq,Show,Read) + +TODO: add queryexpr parens to deal with e.g. +(select 1 union select 2) union select 3 +I'm not sure if this is valid syntax or not. + +> -- | represents the Distinct or All keywords, which can be used +> -- before a select list, in an aggregate/window function +> -- application, or in a query expression set operator +> data Duplicates = Distinct | All deriving (Eq,Show,Read) + +> -- | The direction for a column in order by. +> data Direction = Asc | Desc deriving (Eq,Show,Read) +> -- | Query expression set operators +> data CombineOp = Union | Except | Intersect deriving (Eq,Show,Read) +> -- | Corresponding, an option for the set operators +> data Corresponding = Corresponding | Respectively deriving (Eq,Show,Read) + +> -- | helper/'default' value for query exprs to make creating query +> -- expr values a little easier +> makeSelect :: QueryExpr +> makeSelect = Select {qeDuplicates = All +> ,qeSelectList = [] +> ,qeFrom = [] +> ,qeWhere = Nothing +> ,qeGroupBy = [] +> ,qeHaving = Nothing +> ,qeOrderBy = [] +> ,qeLimit = Nothing +> ,qeOffset = Nothing} + +> -- | Represents a entry in the csv of tables in the from clause. +> data TableRef = -- | from t +> TRSimple String +> -- | from a join b +> | TRJoin TableRef JoinType TableRef (Maybe JoinCondition) +> -- | from (a) +> | TRParens TableRef +> -- | from a as b(c,d) +> | TRAlias TableRef String (Maybe [String]) +> -- | from (query expr) +> | TRQueryExpr QueryExpr +> deriving (Eq,Show,Read) + +TODO: add function table ref + +> -- | The type of a join +> data JoinType = JInner | JLeft | JRight | JFull | JCross +> deriving (Eq,Show,Read) + +> -- | The join condition. +> data JoinCondition = JoinOn ScalarExpr -- ^ on expr +> | JoinUsing [String] -- ^ using (column list) +> | JoinNatural -- ^ natural join was used +> deriving (Eq,Show,Read) diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,5 @@ +A parser for SQL queries in Haskell. + +Homepage: http://jakewheat.github.io/simple_sql_parser/ + +Contact: jakewheatmail@gmail.com diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal new file mode 100644 --- /dev/null +++ b/simple-sql-parser.cabal @@ -0,0 +1,59 @@ +name: simple-sql-parser +version: 0.1.0.0 +synopsis: A parser for SQL queries +description: A parser for SQL queries + +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 +category: Database,Language +build-type: Simple +extra-source-files: README,LICENSE +cabal-version: >=1.10 +bug-reports: https://github.com/JakeWheat/simple_sql_parser/issues + +source-repository head + type: git + location: https://github.com/JakeWheat/simple_sql_parser.git + +library + exposed-modules: Language.SQL.SimpleSQL.Pretty, + Language.SQL.SimpleSQL.Parser, + Language.SQL.SimpleSQL.Syntax + other-modules: Language.SQL.SimpleSQL.Fixity + other-extensions: TupleSections + build-depends: base >=4.6 && <4.7, + parsec >=3.1 && <3.2, + mtl >=2.1 && <2.2, + pretty >= 1.1 && < 1.2, + haskell-src-exts >= 1.14 && < 1.15 + -- hs-source-dirs: + default-language: Haskell2010 + ghc-options: -Wall + +Test-Suite Tests + type: exitcode-stdio-1.0 + main-is: RunTests.lhs + hs-source-dirs: .,tools + Build-Depends: base >=4.6 && <4.7, + parsec >=3.1 && <3.2, + mtl >=2.1 && <2.2, + pretty >= 1.1 && < 1.2, + haskell-src-exts >= 1.14 && < 1.15, + + HUnit >= 1.2 && < 1.3, + test-framework >= 0.8 && < 0.9, + test-framework-hunit >= 0.3 && < 0.4 + + Other-Modules: Language.SQL.SimpleSQL.Pretty, + Language.SQL.SimpleSQL.Parser, + Language.SQL.SimpleSQL.Syntax, + Language.SQL.SimpleSQL.Fixity, + Language.SQL.SimpleSQL.Tests, + Tpch + other-extensions: TupleSections + default-language: Haskell2010 + ghc-options: -Wall diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs new file mode 100644 --- /dev/null +++ b/tools/Language/SQL/SimpleSQL/Tests.lhs @@ -0,0 +1,534 @@ + +> module Language.SQL.SimpleSQL.Tests +> (testData +> ,tests +> ,TestItem(..) +> ) where + +> import Language.SQL.SimpleSQL.Syntax +> import Language.SQL.SimpleSQL.Pretty +> import Language.SQL.SimpleSQL.Parser +> import qualified Test.HUnit as H +> import Tpch +> import Test.Framework +> import Test.Framework.Providers.HUnit + +> data TestItem = Group String [TestItem] +> | TestScalarExpr String ScalarExpr +> | TestQueryExpr String QueryExpr +> | TestQueryExprs String [QueryExpr] +> | ParseQueryExpr String +> deriving (Eq,Show) + +> scalarExprParserTests :: TestItem +> scalarExprParserTests = Group "scalarExprParserTests" +> [literals +> ,identifiers +> ,star +> ,app +> ,caseexp +> ,operators +> ,parens +> ,subqueries +> ,aggregates +> ,windowFunctions +> ] + +> literals :: TestItem +> literals = Group "literals" $ map (uncurry TestScalarExpr) +> [("3", NumLit "3") +> ,("3.", NumLit "3.") +> ,("3.3", NumLit "3.3") +> ,(".3", NumLit ".3") +> ,("3.e3", NumLit "3.e3") +> ,("3.3e3", NumLit "3.3e3") +> ,(".3e3", NumLit ".3e3") +> ,("3e3", NumLit "3e3") +> ,("3e+3", NumLit "3e+3") +> ,("3e-3", NumLit "3e-3") +> ,("'string'", StringLit "string") +> ,("'1'", StringLit "1") +> ,("interval '3' day", IntervalLit "3" "day" Nothing) +> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3) +> ] + +> identifiers :: TestItem +> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr) +> [("iden1", Iden "iden1") +> ,("t.a", Iden2 "t" "a") +> ] + +> star :: TestItem +> star = Group "star" $ map (uncurry TestScalarExpr) +> [("*", Star) +> ,("t.*", Star2 "t") +> ] + +> app :: TestItem +> app = Group "app" $ map (uncurry TestScalarExpr) +> [("f()", App "f" []) +> ,("f(a)", App "f" [Iden "a"]) +> ,("f(a,b)", App "f" [Iden "a", Iden "b"]) +> ] + +> caseexp :: TestItem +> caseexp = Group "caseexp" $ map (uncurry TestScalarExpr) +> [("case a when 1 then 2 end" +> ,Case (Just $ Iden "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") +> ,(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") +> ,(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")] +> (Just $ NumLit "5")) +> ] + +> operators :: TestItem +> operators = Group "operators" +> [binaryOperators +> ,unaryOperators +> ,casts +> ,miscOps] + +> binaryOperators :: TestItem +> binaryOperators = Group "binaryOperators" $ map (uncurry TestScalarExpr) +> [("a + b", BinOp (Iden "a") "+" (Iden "b")) +> -- sanity check fixities +> -- todo: add more fixity checking +> ,("a + b * c" +> ,BinOp (Iden "a") "+" +> (BinOp (Iden "b") "*" (Iden "c"))) +> ,("a * b + c" +> ,BinOp (BinOp (Iden "a") "*" (Iden "b")) +> "+" (Iden "c")) +> ] + +> unaryOperators :: TestItem +> unaryOperators = Group "unaryOperators" $ map (uncurry TestScalarExpr) +> [("not a", PrefixOp "not" $ Iden "a") +> ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a") +> ,("+a", PrefixOp "+" $ Iden "a") +> ,("-a", PrefixOp "-" $ Iden "a") +> ] + + +> casts :: TestItem +> casts = Group "operators" $ map (uncurry TestScalarExpr) +> [("cast('1' as int)" +> ,Cast (StringLit "1") $ TypeName "int") +> ,("int '3'" +> ,CastOp (TypeName "int") "3") +> ,("cast('1' as double precision)" +> ,Cast (StringLit "1") $ TypeName "double precision") +> ,("double precision '3'" +> ,CastOp (TypeName "double precision") "3") +> ] + +> subqueries :: TestItem +> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr) +> [("exists (select a from t)", SubQueryExpr SqExists ms) +> ,("(select a from t)", SubQueryExpr SqSq ms) +> ,("a in (select a from t)" +> ,In True (Iden "a") (InQueryExpr ms)) +> ,("a not in (select a from t)" +> ,In False (Iden "a") (InQueryExpr ms)) +> ,("a > all (select a from t)" +> ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms)) +> ,("a = some (select a from t)" +> ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms)) +> ,("a <= any (select a from t)" +> ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms)) +> ] +> where +> ms = makeSelect +> {qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = [TRSimple "t"] +> } + +> miscOps :: TestItem +> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr) +> [("a in (1,2,3)" +> ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"]) +> ,("a between b and c", SpecialOp "between" [Iden "a" +> ,Iden "b" +> ,Iden "c"]) +> ,("a not between b and c", SpecialOp "not between" [Iden "a" +> ,Iden "b" +> ,Iden "c"]) +> ,("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 not distinct from b" +> ,BinOp (Iden "a") "is not distinct from" (Iden "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 is not similar to b" +> ,BinOp (Iden "a") "is not similar to" (Iden "b")) +> ,("a overlaps b", BinOp (Iden "a") "overlaps" (Iden "b")) +> ,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"]) +> ,("substring(x from 1 for 2)" +> ,SpecialOp "substring" [Iden "x", NumLit "1", NumLit "2"]) +> ] + +> aggregates :: TestItem +> aggregates = Group "aggregates" $ map (uncurry TestScalarExpr) +> [("count(*)",App "count" [Star]) +> ,("sum(a order by a)" +> ,AggregateApp "sum" Nothing [Iden "a"] [(Iden "a", Asc)]) +> ,("sum(all a)" +> ,AggregateApp "sum" (Just All) [Iden "a"] []) +> ,("count(distinct a)" +> ,AggregateApp "count" (Just Distinct) [Iden "a"] []) +> ] + +> windowFunctions :: TestItem +> windowFunctions = Group "windowFunctions" $ map (uncurry TestScalarExpr) +> [("max(a) over ()", WindowApp "max" [Iden "a"] [] []) +> ,("count(*) over ()", WindowApp "count" [Star] [] []) +> ,("max(a) over (partition by b)" +> ,WindowApp "max" [Iden "a"] [Iden "b"] []) +> ,("max(a) over (partition by b,c)" +> ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] []) +> ,("sum(a) over (order by b)" +> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Asc)]) +> ,("sum(a) over (order by b desc,c)" +> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Desc) +> ,(Iden "c", Asc)]) +> ,("sum(a) over (partition by b order by c)" +> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)]) +> -- todo: check order by options, add frames +> ] + +> parens :: TestItem +> parens = Group "parens" $ map (uncurry TestScalarExpr) +> [("(a)", Parens (Iden "a")) +> ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b"))) +> ] + +> queryExprParserTests :: TestItem +> queryExprParserTests = Group "queryExprParserTests" +> [duplicates +> ,selectLists +> ,from +> ,whereClause +> ,groupByClause +> ,having +> ,orderBy +> ,limit +> ,combos +> ,withQueries +> ,fullQueries +> ] + + + +> duplicates :: TestItem +> duplicates = Group "duplicates" $ map (uncurry TestQueryExpr) +> [("select a from t" ,ms All) +> ,("select all a from t" ,ms All) +> ,("select distinct a from t", ms Distinct) +> ] +> where +> ms d = makeSelect +> {qeDuplicates = d +> ,qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = [TRSimple "t"]} + +> selectLists :: TestItem +> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr) +> [("select 1", +> makeSelect {qeSelectList = [(Nothing,NumLit "1")]}) +> ,("select a" +> ,makeSelect {qeSelectList = [(Nothing,Iden "a")]}) +> ,("select a,b" +> ,makeSelect {qeSelectList = [(Nothing,Iden "a") +> ,(Nothing,Iden "b")]}) +> ,("select 1+2,3+4" +> ,makeSelect {qeSelectList = +> [(Nothing,BinOp (NumLit "1") "+" (NumLit "2")) +> ,(Nothing,BinOp (NumLit "3") "+" (NumLit "4"))]}) +> ,("select a as a, /*comment*/ b as b" +> ,makeSelect {qeSelectList = [(Just "a", Iden "a") +> ,(Just "b", Iden "b")]}) +> ,("select a a, b b" +> ,makeSelect {qeSelectList = [(Just "a", Iden "a") +> ,(Just "b", Iden "b")]}) +> ] + +> from :: TestItem +> from = Group "from" $ map (uncurry TestQueryExpr) +> [("select a from t" +> ,ms [TRSimple "t"]) +> ,("select a from t,u" +> ,ms [TRSimple "t", TRSimple "u"]) +> ,("select a from t inner join u on expr" +> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") +> (Just $ JoinOn $ Iden "expr")]) +> ,("select a from t left join u on expr" +> ,ms [TRJoin (TRSimple "t") JLeft (TRSimple "u") +> (Just $ JoinOn $ Iden "expr")]) +> ,("select a from t right join u on expr" +> ,ms [TRJoin (TRSimple "t") JRight (TRSimple "u") +> (Just $ JoinOn $ Iden "expr")]) +> ,("select a from t full join u on expr" +> ,ms [TRJoin (TRSimple "t") JFull (TRSimple "u") +> (Just $ JoinOn $ Iden "expr")]) +> ,("select a from t cross join u" +> ,ms [TRJoin (TRSimple "t") +> JCross (TRSimple "u") Nothing]) +> ,("select a from t natural inner join u" +> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") +> (Just JoinNatural)]) +> ,("select a from t inner join u using(a,b)" +> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") +> (Just $ JoinUsing ["a", "b"])]) +> ,("select a from (select a from t)" +> ,ms [TRQueryExpr $ ms [TRSimple "t"]]) +> ,("select a from t as u" +> ,ms [TRAlias (TRSimple "t") "u" Nothing]) +> ,("select a from t u" +> ,ms [TRAlias (TRSimple "t") "u" Nothing]) +> ,("select a from t u(b)" +> ,ms [TRAlias (TRSimple "t") "u" $ Just ["b"]]) +> ,("select a from (t cross join u) as u" +> ,ms [TRAlias (TRParens $ +> TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing) +> "u" Nothing]) +> -- todo: not sure if the associativity is correct +> ,("select a from t cross join u cross join v", +> ms [TRJoin +> (TRJoin (TRSimple "t") +> JCross (TRSimple "u") Nothing) +> JCross (TRSimple "v") Nothing]) +> ] +> where +> ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = f} + +> whereClause :: TestItem +> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) +> [("select a from t where a = 5" +> ,makeSelect {qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = [TRSimple "t"] +> ,qeWhere = Just $ BinOp (Iden "a") "=" (NumLit "5")}) +> ] + +> groupByClause :: TestItem +> groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr) +> [("select a,sum(b) from t group by a" +> ,makeSelect {qeSelectList = [(Nothing, Iden "a") +> ,(Nothing, App "sum" [Iden "b"])] +> ,qeFrom = [TRSimple "t"] +> ,qeGroupBy = [Iden "a"] +> }) +> ,("select a,b,sum(c) from t group by a,b" +> ,makeSelect {qeSelectList = [(Nothing, Iden "a") +> ,(Nothing, Iden "b") +> ,(Nothing, App "sum" [Iden "c"])] +> ,qeFrom = [TRSimple "t"] +> ,qeGroupBy = [Iden "a",Iden "b"] +> }) +> ] + +> having :: TestItem +> having = Group "having" $ map (uncurry TestQueryExpr) +> [("select a,sum(b) from t group by a having sum(b) > 5" +> ,makeSelect {qeSelectList = [(Nothing, Iden "a") +> ,(Nothing, App "sum" [Iden "b"])] +> ,qeFrom = [TRSimple "t"] +> ,qeGroupBy = [Iden "a"] +> ,qeHaving = Just $ BinOp (App "sum" [Iden "b"]) +> ">" (NumLit "5") +> }) +> ] + +> orderBy :: TestItem +> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr) +> [("select a from t order by a" +> ,ms [(Iden "a", Asc)]) +> ,("select a from t order by a, b" +> ,ms [(Iden "a", Asc), (Iden "b", Asc)]) +> ,("select a from t order by a asc" +> ,ms [(Iden "a", Asc)]) +> ,("select a from t order by a desc, b desc" +> ,ms [(Iden "a", Desc), (Iden "b", Desc)]) +> ] +> where +> ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = [TRSimple "t"] +> ,qeOrderBy = o} + +> limit :: TestItem +> limit = Group "limit" $ map (uncurry TestQueryExpr) +> [("select a from t limit 10" +> ,ms (Just $ NumLit "10") Nothing) +> ,("select a from t limit 10 offset 10" +> ,ms (Just $ NumLit "10") (Just $ NumLit "10")) +> ] +> where +> ms l o = makeSelect +> {qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = [TRSimple "t"] +> ,qeLimit = l +> ,qeOffset = o} + +> combos :: TestItem +> combos = Group "combos" $ map (uncurry TestQueryExpr) +> [("select a from t union select b from u" +> ,CombineQueryExpr ms1 Union All Respectively ms2) +> ,("select a from t intersect select b from u" +> ,CombineQueryExpr ms1 Intersect All Respectively ms2) +> ,("select a from t except all select b from u" +> ,CombineQueryExpr ms1 Except All Respectively ms2) +> ,("select a from t union distinct corresponding \ +> \select b from u" +> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2) +> ,("select a from t union select a from t union select a from t" +> -- is this the correct associativity? +> ,CombineQueryExpr ms1 Union All Respectively +> (CombineQueryExpr ms1 Union All Respectively ms1)) +> ] +> where +> ms1 = makeSelect +> {qeSelectList = [(Nothing,Iden "a")] +> ,qeFrom = [TRSimple "t"]} +> ms2 = makeSelect +> {qeSelectList = [(Nothing,Iden "b")] +> ,qeFrom = [TRSimple "u"]} + + +> withQueries :: TestItem +> withQueries = Group "with queries" $ map (uncurry TestQueryExpr) +> [("with u as (select a from t) select a from u" +> ,With [("u", ms1)] ms2) +> ,("with x as (select a from t),\n\ +> \ u as (select a from x)\n\ +> \select a from u" +> ,With [("x", ms1), ("u",ms3)] ms2) +> ] +> where +> ms c t = makeSelect +> {qeSelectList = [(Nothing,Iden c)] +> ,qeFrom = [TRSimple t]} +> ms1 = ms "a" "t" +> ms2 = ms "a" "u" +> ms3 = ms "a" "x" + + +> fullQueries :: TestItem +> fullQueries = Group "queries" $ map (uncurry TestQueryExpr) +> [("select count(*) from t" +> ,makeSelect +> {qeSelectList = [(Nothing, App "count" [Star])] +> ,qeFrom = [TRSimple "t"] +> } +> ) +> ,("select a, sum(c+d) as s\n\ +> \ from t,u\n\ +> \ where a > 5\n\ +> \ group by a\n\ +> \ having count(1) > 5\n\ +> \ order by s" +> ,makeSelect +> {qeSelectList = [(Nothing, Iden "a") +> ,(Just "s" +> ,App "sum" [BinOp (Iden "c") +> "+" (Iden "d")])] +> ,qeFrom = [TRSimple "t", TRSimple "u"] +> ,qeWhere = Just $ BinOp (Iden "a") ">" (NumLit "5") +> ,qeGroupBy = [Iden "a"] +> ,qeHaving = Just $ BinOp (App "count" [NumLit "1"]) +> ">" (NumLit "5") +> ,qeOrderBy = [(Iden "s", Asc)] +> } +> ) +> ] + +> queryExprsParserTests :: TestItem +> queryExprsParserTests = Group "query exprs" $ map (uncurry TestQueryExprs) +> [("select 1",[ms]) +> ,("select 1;",[ms]) +> ,("select 1;select 1",[ms,ms]) +> ,("select 1;select 1;",[ms,ms]) +> ,(" select 1;select 1; ",[ms,ms]) +> ] +> where +> ms = makeSelect {qeSelectList = [(Nothing,NumLit "1")]} + +> tpchTests :: TestItem +> tpchTests = +> Group "parse tpch" +> $ map (ParseQueryExpr . snd) tpchQueries + +> testData :: TestItem +> testData = +> Group "parserTest" +> [scalarExprParserTests +> ,queryExprParserTests +> ,queryExprsParserTests +> ,tpchTests +> ] + +> tests :: Test.Framework.Test +> tests = itemToTest testData + +> --runTests :: IO () +> --runTests = void $ H.runTestTT $ itemToTest testData + +> itemToTest :: TestItem -> Test.Framework.Test +> itemToTest (Group nm ts) = +> testGroup nm $ map itemToTest ts +> itemToTest (TestScalarExpr str expected) = +> toTest parseScalarExpr prettyScalarExpr str expected +> itemToTest (TestQueryExpr str expected) = +> toTest parseQueryExpr prettyQueryExpr str expected +> itemToTest (TestQueryExprs str expected) = +> toTest parseQueryExprs prettyQueryExprs str expected +> itemToTest (ParseQueryExpr str) = +> toPTest parseQueryExpr prettyQueryExpr str + +> toTest :: (Eq a, Show a) => +> (String -> Maybe (Int,Int) -> String -> Either ParseError a) +> -> (a -> String) +> -> String +> -> a +> -> Test.Framework.Test +> toTest parser pp str expected = testCase str $ do +> let egot = parser "" Nothing str +> case egot of +> Left e -> H.assertFailure $ peFormattedError e +> Right got -> do +> H.assertEqual "" expected got +> let str' = pp got +> let egot' = parser "" Nothing str' +> case egot' of +> Left e' -> H.assertFailure $ "pp roundtrip " ++ peFormattedError e' +> Right got' -> H.assertEqual "pp roundtrip" expected got' + +> toPTest :: (Eq a, Show a) => +> (String -> Maybe (Int,Int) -> String -> Either ParseError a) +> -> (a -> String) +> -> String +> -> Test.Framework.Test +> toPTest parser pp str = testCase str $ do +> let egot = parser "" Nothing str +> case egot of +> Left e -> H.assertFailure $ peFormattedError e +> Right got -> do +> let str' = pp got +> let egot' = parser "" Nothing str' +> case egot' of +> Left e' -> H.assertFailure $ "pp roundtrip " ++ peFormattedError e' +> Right _got' -> return () diff --git a/tools/RunTests.lhs b/tools/RunTests.lhs new file mode 100644 --- /dev/null +++ b/tools/RunTests.lhs @@ -0,0 +1,8 @@ + + +> import Test.Framework + +> import Language.SQL.SimpleSQL.Tests + +> main :: IO () +> main = defaultMain [tests] diff --git a/tools/Tpch.lhs b/tools/Tpch.lhs new file mode 100644 --- /dev/null +++ b/tools/Tpch.lhs @@ -0,0 +1,675 @@ + +test data for tpch queries + + +> {-# LANGUAGE OverloadedStrings #-} + +> module Tpch (tpchQueries) where +> + +> tpchQueries :: [(String,String)] +> tpchQueries = +> [("Q1","\n\ +> \select\n\ +> \ l_returnflag,\n\ +> \ l_linestatus,\n\ +> \ sum(l_quantity) as sum_qty,\n\ +> \ sum(l_extendedprice) as sum_base_price,\n\ +> \ sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,\n\ +> \ sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,\n\ +> \ avg(l_quantity) as avg_qty,\n\ +> \ avg(l_extendedprice) as avg_price,\n\ +> \ avg(l_discount) as avg_disc,\n\ +> \ count(*) as count_order\n\ +> \from\n\ +> \ lineitem\n\ +> \where\n\ +> \ l_shipdate <= date '1998-12-01' - interval '63' day (3)\n\ +> \group by\n\ +> \ l_returnflag,\n\ +> \ l_linestatus\n\ +> \order by\n\ +> \ l_returnflag,\n\ +> \ l_linestatus") +> ,("Q2","\n\ +> \select\n\ +> \ s_acctbal,\n\ +> \ s_name,\n\ +> \ n_name,\n\ +> \ p_partkey,\n\ +> \ p_mfgr,\n\ +> \ s_address,\n\ +> \ s_phone,\n\ +> \ s_comment\n\ +> \from\n\ +> \ part,\n\ +> \ supplier,\n\ +> \ partsupp,\n\ +> \ nation,\n\ +> \ region\n\ +> \where\n\ +> \ p_partkey = ps_partkey\n\ +> \ and s_suppkey = ps_suppkey\n\ +> \ and p_size = 15\n\ +> \ and p_type like '%BRASS'\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_regionkey = r_regionkey\n\ +> \ and r_name = 'EUROPE'\n\ +> \ and ps_supplycost = (\n\ +> \ select\n\ +> \ min(ps_supplycost)\n\ +> \ from\n\ +> \ partsupp,\n\ +> \ supplier,\n\ +> \ nation,\n\ +> \ region\n\ +> \ where\n\ +> \ p_partkey = ps_partkey\n\ +> \ and s_suppkey = ps_suppkey\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_regionkey = r_regionkey\n\ +> \ and r_name = 'EUROPE'\n\ +> \ )\n\ +> \order by\n\ +> \ s_acctbal desc,\n\ +> \ n_name,\n\ +> \ s_name,\n\ +> \ p_partkey\n\ +> \limit 100") +> ,("Q3","\n\ +> \ select\n\ +> \ l_orderkey,\n\ +> \ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\ +> \ o_orderdate,\n\ +> \ o_shippriority\n\ +> \ from\n\ +> \ customer,\n\ +> \ orders,\n\ +> \ lineitem\n\ +> \ where\n\ +> \ c_mktsegment = 'MACHINERY'\n\ +> \ and c_custkey = o_custkey\n\ +> \ and l_orderkey = o_orderkey\n\ +> \ and o_orderdate < date '1995-03-21'\n\ +> \ and l_shipdate > date '1995-03-21'\n\ +> \ group by\n\ +> \ l_orderkey,\n\ +> \ o_orderdate,\n\ +> \ o_shippriority\n\ +> \ order by\n\ +> \ revenue desc,\n\ +> \ o_orderdate\n\ +> \ limit 10") +> ,("Q4","\n\ +> \ select\n\ +> \ o_orderpriority,\n\ +> \ count(*) as order_count\n\ +> \ from\n\ +> \ orders\n\ +> \ where\n\ +> \ o_orderdate >= date '1996-03-01'\n\ +> \ and o_orderdate < date '1996-03-01' + interval '3' month\n\ +> \ and exists (\n\ +> \ select\n\ +> \ *\n\ +> \ from\n\ +> \ lineitem\n\ +> \ where\n\ +> \ l_orderkey = o_orderkey\n\ +> \ and l_commitdate < l_receiptdate\n\ +> \ )\n\ +> \ group by\n\ +> \ o_orderpriority\n\ +> \ order by\n\ +> \ o_orderpriority") +> ,("Q5","\n\ +> \ select\n\ +> \ n_name,\n\ +> \ sum(l_extendedprice * (1 - l_discount)) as revenue\n\ +> \ from\n\ +> \ customer,\n\ +> \ orders,\n\ +> \ lineitem,\n\ +> \ supplier,\n\ +> \ nation,\n\ +> \ region\n\ +> \ where\n\ +> \ c_custkey = o_custkey\n\ +> \ and l_orderkey = o_orderkey\n\ +> \ and l_suppkey = s_suppkey\n\ +> \ and c_nationkey = s_nationkey\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_regionkey = r_regionkey\n\ +> \ and r_name = 'EUROPE'\n\ +> \ and o_orderdate >= date '1997-01-01'\n\ +> \ and o_orderdate < date '1997-01-01' + interval '1' year\n\ +> \ group by\n\ +> \ n_name\n\ +> \ order by\n\ +> \ revenue desc") +> ,("Q6","\n\ +> \ select\n\ +> \ sum(l_extendedprice * l_discount) as revenue\n\ +> \ from\n\ +> \ lineitem\n\ +> \ where\n\ +> \ l_shipdate >= date '1997-01-01'\n\ +> \ and l_shipdate < date '1997-01-01' + interval '1' year\n\ +> \ and l_discount between 0.07 - 0.01 and 0.07 + 0.01\n\ +> \ and l_quantity < 24") +> ,("Q7","\n\ +> \ select\n\ +> \ supp_nation,\n\ +> \ cust_nation,\n\ +> \ l_year,\n\ +> \ sum(volume) as revenue\n\ +> \ from\n\ +> \ (\n\ +> \ select\n\ +> \ n1.n_name as supp_nation,\n\ +> \ n2.n_name as cust_nation,\n\ +> \ extract(year from l_shipdate) as l_year,\n\ +> \ l_extendedprice * (1 - l_discount) as volume\n\ +> \ from\n\ +> \ supplier,\n\ +> \ lineitem,\n\ +> \ orders,\n\ +> \ customer,\n\ +> \ nation n1,\n\ +> \ nation n2\n\ +> \ where\n\ +> \ s_suppkey = l_suppkey\n\ +> \ and o_orderkey = l_orderkey\n\ +> \ and c_custkey = o_custkey\n\ +> \ and s_nationkey = n1.n_nationkey\n\ +> \ and c_nationkey = n2.n_nationkey\n\ +> \ and (\n\ +> \ (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')\n\ +> \ or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')\n\ +> \ )\n\ +> \ and l_shipdate between date '1995-01-01' and date '1996-12-31'\n\ +> \ ) as shipping\n\ +> \ group by\n\ +> \ supp_nation,\n\ +> \ cust_nation,\n\ +> \ l_year\n\ +> \ order by\n\ +> \ supp_nation,\n\ +> \ cust_nation,\n\ +> \ l_year") +> ,("Q8","\n\ +> \ select\n\ +> \ o_year,\n\ +> \ sum(case\n\ +> \ when nation = 'IRAQ' then volume\n\ +> \ else 0\n\ +> \ end) / sum(volume) as mkt_share\n\ +> \ from\n\ +> \ (\n\ +> \ select\n\ +> \ extract(year from o_orderdate) as o_year,\n\ +> \ l_extendedprice * (1 - l_discount) as volume,\n\ +> \ n2.n_name as nation\n\ +> \ from\n\ +> \ part,\n\ +> \ supplier,\n\ +> \ lineitem,\n\ +> \ orders,\n\ +> \ customer,\n\ +> \ nation n1,\n\ +> \ nation n2,\n\ +> \ region\n\ +> \ where\n\ +> \ p_partkey = l_partkey\n\ +> \ and s_suppkey = l_suppkey\n\ +> \ and l_orderkey = o_orderkey\n\ +> \ and o_custkey = c_custkey\n\ +> \ and c_nationkey = n1.n_nationkey\n\ +> \ and n1.n_regionkey = r_regionkey\n\ +> \ and r_name = 'MIDDLE EAST'\n\ +> \ and s_nationkey = n2.n_nationkey\n\ +> \ and o_orderdate between date '1995-01-01' and date '1996-12-31'\n\ +> \ and p_type = 'STANDARD ANODIZED BRASS'\n\ +> \ ) as all_nations\n\ +> \ group by\n\ +> \ o_year\n\ +> \ order by\n\ +> \ o_year") +> ,("Q9","\n\ +> \ select\n\ +> \ nation,\n\ +> \ o_year,\n\ +> \ sum(amount) as sum_profit\n\ +> \ from\n\ +> \ (\n\ +> \ select\n\ +> \ n_name as nation,\n\ +> \ extract(year from o_orderdate) as o_year,\n\ +> \ l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount\n\ +> \ from\n\ +> \ part,\n\ +> \ supplier,\n\ +> \ lineitem,\n\ +> \ partsupp,\n\ +> \ orders,\n\ +> \ nation\n\ +> \ where\n\ +> \ s_suppkey = l_suppkey\n\ +> \ and ps_suppkey = l_suppkey\n\ +> \ and ps_partkey = l_partkey\n\ +> \ and p_partkey = l_partkey\n\ +> \ and o_orderkey = l_orderkey\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and p_name like '%antique%'\n\ +> \ ) as profit\n\ +> \ group by\n\ +> \ nation,\n\ +> \ o_year\n\ +> \ order by\n\ +> \ nation,\n\ +> \ o_year desc") +> ,("Q10","\n\ +> \ select\n\ +> \ c_custkey,\n\ +> \ c_name,\n\ +> \ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\ +> \ c_acctbal,\n\ +> \ n_name,\n\ +> \ c_address,\n\ +> \ c_phone,\n\ +> \ c_comment\n\ +> \ from\n\ +> \ customer,\n\ +> \ orders,\n\ +> \ lineitem,\n\ +> \ nation\n\ +> \ where\n\ +> \ c_custkey = o_custkey\n\ +> \ and l_orderkey = o_orderkey\n\ +> \ and o_orderdate >= date '1993-12-01'\n\ +> \ and o_orderdate < date '1993-12-01' + interval '3' month\n\ +> \ and l_returnflag = 'R'\n\ +> \ and c_nationkey = n_nationkey\n\ +> \ group by\n\ +> \ c_custkey,\n\ +> \ c_name,\n\ +> \ c_acctbal,\n\ +> \ c_phone,\n\ +> \ n_name,\n\ +> \ c_address,\n\ +> \ c_comment\n\ +> \ order by\n\ +> \ revenue desc\n\ +> \ limit 20") +> ,("Q11","\n\ +> \ select\n\ +> \ ps_partkey,\n\ +> \ sum(ps_supplycost * ps_availqty) as value\n\ +> \ from\n\ +> \ partsupp,\n\ +> \ supplier,\n\ +> \ nation\n\ +> \ where\n\ +> \ ps_suppkey = s_suppkey\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_name = 'CHINA'\n\ +> \ group by\n\ +> \ ps_partkey having\n\ +> \ sum(ps_supplycost * ps_availqty) > (\n\ +> \ select\n\ +> \ sum(ps_supplycost * ps_availqty) * 0.0001000000\n\ +> \ from\n\ +> \ partsupp,\n\ +> \ supplier,\n\ +> \ nation\n\ +> \ where\n\ +> \ ps_suppkey = s_suppkey\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_name = 'CHINA'\n\ +> \ )\n\ +> \ order by\n\ +> \ value desc") +> ,("Q12","\n\ +> \ select\n\ +> \ l_shipmode,\n\ +> \ sum(case\n\ +> \ when o_orderpriority = '1-URGENT'\n\ +> \ or o_orderpriority = '2-HIGH'\n\ +> \ then 1\n\ +> \ else 0\n\ +> \ end) as high_line_count,\n\ +> \ sum(case\n\ +> \ when o_orderpriority <> '1-URGENT'\n\ +> \ and o_orderpriority <> '2-HIGH'\n\ +> \ then 1\n\ +> \ else 0\n\ +> \ end) as low_line_count\n\ +> \ from\n\ +> \ orders,\n\ +> \ lineitem\n\ +> \ where\n\ +> \ o_orderkey = l_orderkey\n\ +> \ and l_shipmode in ('AIR', 'RAIL')\n\ +> \ and l_commitdate < l_receiptdate\n\ +> \ and l_shipdate < l_commitdate\n\ +> \ and l_receiptdate >= date '1994-01-01'\n\ +> \ and l_receiptdate < date '1994-01-01' + interval '1' year\n\ +> \ group by\n\ +> \ l_shipmode\n\ +> \ order by\n\ +> \ l_shipmode") +> ,("Q13","\n\ +> \ select\n\ +> \ c_count,\n\ +> \ count(*) as custdist\n\ +> \ from\n\ +> \ (\n\ +> \ select\n\ +> \ c_custkey,\n\ +> \ count(o_orderkey)\n\ +> \ from\n\ +> \ customer left outer join orders on\n\ +> \ c_custkey = o_custkey\n\ +> \ and o_comment not like '%pending%requests%'\n\ +> \ group by\n\ +> \ c_custkey\n\ +> \ ) as c_orders (c_custkey, c_count)\n\ +> \ group by\n\ +> \ c_count\n\ +> \ order by\n\ +> \ custdist desc,\n\ +> \ c_count desc") +> ,("Q14","\n\ +> \ select\n\ +> \ 100.00 * sum(case\n\ +> \ when p_type like 'PROMO%'\n\ +> \ then l_extendedprice * (1 - l_discount)\n\ +> \ else 0\n\ +> \ end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue\n\ +> \ from\n\ +> \ lineitem,\n\ +> \ part\n\ +> \ where\n\ +> \ l_partkey = p_partkey\n\ +> \ and l_shipdate >= date '1994-12-01'\n\ +> \ and l_shipdate < date '1994-12-01' + interval '1' month") +> ,("Q15","\n\ +> \ /*create view revenue0 (supplier_no, total_revenue) as\n\ +> \ select\n\ +> \ l_suppkey,\n\ +> \ sum(l_extendedprice * (1 - l_discount))\n\ +> \ from\n\ +> \ lineitem\n\ +> \ where\n\ +> \ l_shipdate >= date '1995-06-01'\n\ +> \ and l_shipdate < date '1995-06-01' + interval '3' month\n\ +> \ group by\n\ +> \ l_suppkey;*/\n\ +> \ with\n\ +> \ revenue0 as\n\ +> \ (select\n\ +> \ l_suppkey as supplier_no,\n\ +> \ sum(l_extendedprice * (1 - l_discount)) as total_revenue\n\ +> \ from\n\ +> \ lineitem\n\ +> \ where\n\ +> \ l_shipdate >= date '1995-06-01'\n\ +> \ and l_shipdate < date '1995-06-01' + interval '3' month\n\ +> \ group by\n\ +> \ l_suppkey)\n\ +> \ select\n\ +> \ s_suppkey,\n\ +> \ s_name,\n\ +> \ s_address,\n\ +> \ s_phone,\n\ +> \ total_revenue\n\ +> \ from\n\ +> \ supplier,\n\ +> \ revenue0\n\ +> \ where\n\ +> \ s_suppkey = supplier_no\n\ +> \ and total_revenue = (\n\ +> \ select\n\ +> \ max(total_revenue)\n\ +> \ from\n\ +> \ revenue0\n\ +> \ )\n\ +> \ order by\n\ +> \ s_suppkey") +> ,("Q16","\n\ +> \ select\n\ +> \ p_brand,\n\ +> \ p_type,\n\ +> \ p_size,\n\ +> \ count(distinct ps_suppkey) as supplier_cnt\n\ +> \ from\n\ +> \ partsupp,\n\ +> \ part\n\ +> \ where\n\ +> \ p_partkey = ps_partkey\n\ +> \ and p_brand <> 'Brand#15'\n\ +> \ and p_type not like 'MEDIUM BURNISHED%'\n\ +> \ and p_size in (39, 26, 18, 45, 19, 1, 3, 9)\n\ +> \ and ps_suppkey not in (\n\ +> \ select\n\ +> \ s_suppkey\n\ +> \ from\n\ +> \ supplier\n\ +> \ where\n\ +> \ s_comment like '%Customer%Complaints%'\n\ +> \ )\n\ +> \ group by\n\ +> \ p_brand,\n\ +> \ p_type,\n\ +> \ p_size\n\ +> \ order by\n\ +> \ supplier_cnt desc,\n\ +> \ p_brand,\n\ +> \ p_type,\n\ +> \ p_size") +> ,("Q17","\n\ +> \ select\n\ +> \ sum(l_extendedprice) / 7.0 as avg_yearly\n\ +> \ from\n\ +> \ lineitem,\n\ +> \ part\n\ +> \ where\n\ +> \ p_partkey = l_partkey\n\ +> \ and p_brand = 'Brand#52'\n\ +> \ and p_container = 'JUMBO CAN'\n\ +> \ and l_quantity < (\n\ +> \ select\n\ +> \ 0.2 * avg(l_quantity)\n\ +> \ from\n\ +> \ lineitem\n\ +> \ where\n\ +> \ l_partkey = p_partkey\n\ +> \ )") +> ,("Q18","\n\ +> \ select\n\ +> \ c_name,\n\ +> \ c_custkey,\n\ +> \ o_orderkey,\n\ +> \ o_orderdate,\n\ +> \ o_totalprice,\n\ +> \ sum(l_quantity)\n\ +> \ from\n\ +> \ customer,\n\ +> \ orders,\n\ +> \ lineitem\n\ +> \ where\n\ +> \ o_orderkey in (\n\ +> \ select\n\ +> \ l_orderkey\n\ +> \ from\n\ +> \ lineitem\n\ +> \ group by\n\ +> \ l_orderkey having\n\ +> \ sum(l_quantity) > 313\n\ +> \ )\n\ +> \ and c_custkey = o_custkey\n\ +> \ and o_orderkey = l_orderkey\n\ +> \ group by\n\ +> \ c_name,\n\ +> \ c_custkey,\n\ +> \ o_orderkey,\n\ +> \ o_orderdate,\n\ +> \ o_totalprice\n\ +> \ order by\n\ +> \ o_totalprice desc,\n\ +> \ o_orderdate\n\ +> \ limit 100") +> ,("Q19","\n\ +> \ select\n\ +> \ sum(l_extendedprice* (1 - l_discount)) as revenue\n\ +> \ from\n\ +> \ lineitem,\n\ +> \ part\n\ +> \ where\n\ +> \ (\n\ +> \ p_partkey = l_partkey\n\ +> \ and p_brand = 'Brand#43'\n\ +> \ and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')\n\ +> \ and l_quantity >= 3 and l_quantity <= 3 + 10\n\ +> \ and p_size between 1 and 5\n\ +> \ and l_shipmode in ('AIR', 'AIR REG')\n\ +> \ and l_shipinstruct = 'DELIVER IN PERSON'\n\ +> \ )\n\ +> \ or\n\ +> \ (\n\ +> \ p_partkey = l_partkey\n\ +> \ and p_brand = 'Brand#25'\n\ +> \ and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')\n\ +> \ and l_quantity >= 10 and l_quantity <= 10 + 10\n\ +> \ and p_size between 1 and 10\n\ +> \ and l_shipmode in ('AIR', 'AIR REG')\n\ +> \ and l_shipinstruct = 'DELIVER IN PERSON'\n\ +> \ )\n\ +> \ or\n\ +> \ (\n\ +> \ p_partkey = l_partkey\n\ +> \ and p_brand = 'Brand#24'\n\ +> \ and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')\n\ +> \ and l_quantity >= 22 and l_quantity <= 22 + 10\n\ +> \ and p_size between 1 and 15\n\ +> \ and l_shipmode in ('AIR', 'AIR REG')\n\ +> \ and l_shipinstruct = 'DELIVER IN PERSON'\n\ +> \ )") +> ,("Q20","\n\ +> \ select\n\ +> \ s_name,\n\ +> \ s_address\n\ +> \ from\n\ +> \ supplier,\n\ +> \ nation\n\ +> \ where\n\ +> \ s_suppkey in (\n\ +> \ select\n\ +> \ ps_suppkey\n\ +> \ from\n\ +> \ partsupp\n\ +> \ where\n\ +> \ ps_partkey in (\n\ +> \ select\n\ +> \ p_partkey\n\ +> \ from\n\ +> \ part\n\ +> \ where\n\ +> \ p_name like 'lime%'\n\ +> \ )\n\ +> \ and ps_availqty > (\n\ +> \ select\n\ +> \ 0.5 * sum(l_quantity)\n\ +> \ from\n\ +> \ lineitem\n\ +> \ where\n\ +> \ l_partkey = ps_partkey\n\ +> \ and l_suppkey = ps_suppkey\n\ +> \ and l_shipdate >= date '1994-01-01'\n\ +> \ and l_shipdate < date '1994-01-01' + interval '1' year\n\ +> \ )\n\ +> \ )\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_name = 'VIETNAM'\n\ +> \ order by\n\ +> \ s_name") +> ,("Q21","\n\ +> \ select\n\ +> \ s_name,\n\ +> \ count(*) as numwait\n\ +> \ from\n\ +> \ supplier,\n\ +> \ lineitem l1,\n\ +> \ orders,\n\ +> \ nation\n\ +> \ where\n\ +> \ s_suppkey = l1.l_suppkey\n\ +> \ and o_orderkey = l1.l_orderkey\n\ +> \ and o_orderstatus = 'F'\n\ +> \ and l1.l_receiptdate > l1.l_commitdate\n\ +> \ and exists (\n\ +> \ select\n\ +> \ *\n\ +> \ from\n\ +> \ lineitem l2\n\ +> \ where\n\ +> \ l2.l_orderkey = l1.l_orderkey\n\ +> \ and l2.l_suppkey <> l1.l_suppkey\n\ +> \ )\n\ +> \ and not exists (\n\ +> \ select\n\ +> \ *\n\ +> \ from\n\ +> \ lineitem l3\n\ +> \ where\n\ +> \ l3.l_orderkey = l1.l_orderkey\n\ +> \ and l3.l_suppkey <> l1.l_suppkey\n\ +> \ and l3.l_receiptdate > l3.l_commitdate\n\ +> \ )\n\ +> \ and s_nationkey = n_nationkey\n\ +> \ and n_name = 'INDIA'\n\ +> \ group by\n\ +> \ s_name\n\ +> \ order by\n\ +> \ numwait desc,\n\ +> \ s_name\n\ +> \ limit 100") +> ,("Q22","\n\ +> \ select\n\ +> \ cntrycode,\n\ +> \ count(*) as numcust,\n\ +> \ sum(c_acctbal) as totacctbal\n\ +> \ from\n\ +> \ (\n\ +> \ select\n\ +> \ substring(c_phone from 1 for 2) as cntrycode,\n\ +> \ c_acctbal\n\ +> \ from\n\ +> \ customer\n\ +> \ where\n\ +> \ substring(c_phone from 1 for 2) in\n\ +> \ ('41', '28', '39', '21', '24', '29', '44')\n\ +> \ and c_acctbal > (\n\ +> \ select\n\ +> \ avg(c_acctbal)\n\ +> \ from\n\ +> \ customer\n\ +> \ where\n\ +> \ c_acctbal > 0.00\n\ +> \ and substring(c_phone from 1 for 2) in\n\ +> \ ('41', '28', '39', '21', '24', '29', '44')\n\ +> \ )\n\ +> \ and not exists (\n\ +> \ select\n\ +> \ *\n\ +> \ from\n\ +> \ orders\n\ +> \ where\n\ +> \ o_custkey = c_custkey\n\ +> \ )\n\ +> \ ) as custsale\n\ +> \ group by\n\ +> \ cntrycode\n\ +> \ order by\n\ +> \ cntrycode") +> ]