From 3b2730fd9962b9a51ad659191ac842364dab86b4 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Thu, 19 Dec 2013 11:46:51 +0200 Subject: [PATCH] rename ScalarExpr -> ValueExpr which is slightly more standard, add notes on new fixity implementation --- Language/SQL/SimpleSQL/Fixity.lhs | 53 +++++- Language/SQL/SimpleSQL/Parser.lhs | 180 +++++++++--------- Language/SQL/SimpleSQL/Pretty.lhs | 134 ++++++------- Language/SQL/SimpleSQL/Syntax.lhs | 72 +++---- TODO | 26 ++- simple-sql-parser.cabal | 2 +- tools/Language/SQL/SimpleSQL/TestTypes.lhs | 2 +- tools/Language/SQL/SimpleSQL/Tests.lhs | 20 +- .../{ScalarExprs.lhs => ValueExprs.lhs} | 38 ++-- 9 files changed, 285 insertions(+), 242 deletions(-) rename tools/Language/SQL/SimpleSQL/{ScalarExprs.lhs => ValueExprs.lhs} (91%) diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs index 77b01e5..71afe24 100644 --- a/Language/SQL/SimpleSQL/Fixity.lhs +++ b/Language/SQL/SimpleSQL/Fixity.lhs @@ -1,10 +1,47 @@ -This is the module which deals with fixing up the scalar expression +This is the module which deals with fixing up the value 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? +made generic to use in places other than the value expr parser? + + + +New plan to write custom fixity code to work directly on +simple-query-parser AST. + +Might also want to run simple fixity fixes on CombineQueryExprs, and +on tableref trees. + +these operators take part in fixity: +binop prefixop postfixop +in, any, some, all +between: maybe postfix ops might be either in the last expr in the +between or outside the between (& not between) +collate + +these don't: we just recursively apply on each sub value expr +independently +all special ops, except the special case for between +case, should check nested cases work nice +app, agg app, winapp, parens +casts: + cast(a as b) doesn't + int 'sdasd' doesn't since the argument is a string literal only + a::b does, this is postgres which isn't currently supported. Would + like to support it in the future though. This will not be a ast + binary op since the second argument is a typename and not a value + expr + +because the parser applies the fixity fix to every 'top level' value +expr, we don't need to descend into query exprs to find the value +exprs inside them. + +start creating test list + + + > {-# LANGUAGE TupleSections #-} > module Language.SQL.SimpleSQL.Fixity @@ -52,24 +89,24 @@ made generic to use in places other than the scalar expr parser? > AssocRight -> HSE.infixr_ n [nm] > AssocNone -> HSE.infix_ n [nm] -fix the fixities in the given scalar expr. All the expressions to be +fix the fixities in the given value 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. +the value 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 :: [[Fixity]] -> ValueExpr -> ValueExpr > fixFixities fs se = > runIdentity $ toSql <$> HSE.applyFixities (toHSEFixity fs) (toHaskell se) -Now have to convert all our scalar exprs to Haskell and back again. +Now have to convert all our value 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 :: ValueExpr -> HSE.Exp > toHaskell e = case e of > BinOp e0 op e1 -> HSE.InfixApp > (toHaskell e0) @@ -128,7 +165,7 @@ the fixity code. -> toSql :: HSE.Exp -> ScalarExpr +> toSql :: HSE.Exp -> ValueExpr > toSql e = case e of diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 1104c1c..2b0c24f 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -3,7 +3,7 @@ > -- | This is the module with the parser functions. > module Language.SQL.SimpleSQL.Parser > (parseQueryExpr -> ,parseScalarExpr +> ,parseValueExpr > ,parseQueryExprs > ,ParseError(..)) where @@ -41,15 +41,15 @@ The public API functions. > -> Either ParseError [QueryExpr] > parseQueryExprs = wrapParse queryExprs -> -- | Parses a scalar expression. -> parseScalarExpr :: FilePath +> -- | Parses a value expression. +> parseValueExpr :: 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 +> -> Either ParseError ValueExpr +> parseValueExpr = wrapParse valueExpr This helper function takes the parser given and: @@ -84,16 +84,16 @@ converts the error return to the nice wrapper > type P a = ParsecT String () Identity a -= scalar expressions += value expressions == literals See the stringLiteral lexer below for notes on string literal syntax. -> estring :: P ScalarExpr +> estring :: P ValueExpr > estring = StringLit <$> stringLiteral -> number :: P ScalarExpr +> number :: P ValueExpr > number = NumLit <$> numberLiteral parse SQL interval literals, something like @@ -105,14 +105,14 @@ wrap the whole lot in try, in case we get something like this: interval '3 days' which parses as a typed literal -> interval :: P ScalarExpr +> interval :: P ValueExpr > interval = try (keyword_ "interval" >> > IntervalLit > <$> stringLiteral > <*> identifierString > <*> optionMaybe (try $ parens integerLiteral)) -> literal :: P ScalarExpr +> literal :: P ValueExpr > literal = number <|> estring <|> interval == identifiers @@ -124,7 +124,7 @@ identifiers. > name = choice [QName <$> quotedIdentifier > ,Name <$> identifierString] -> identifier :: P ScalarExpr +> identifier :: P ValueExpr > identifier = Iden <$> name == star @@ -132,34 +132,34 @@ identifiers. 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 scalar expression context. +in any value expression context. -> star :: P ScalarExpr +> star :: P ValueExpr > star = Star <$ symbol "*" == parameter use in e.g. select * from t where a = ? -> parameter :: P ScalarExpr +> parameter :: P 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 scalar +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 :: P ScalarExpr +> aggOrApp :: P ValueExpr > aggOrApp = > makeApp > <$> name > <*> parens ((,,) <$> try duplicates -> <*> choice [commaSep scalarExpr'] +> <*> choice [commaSep valueExpr'] > <*> try (optionMaybe orderBy)) > where > makeApp i (Nothing,es,Nothing) = App i es @@ -180,7 +180,7 @@ 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 :: ValueExpr -> P ValueExpr > windowSuffix (App f es) = > try (keyword_ "over") > *> parens (WindowApp f es @@ -189,7 +189,7 @@ always used with the optionSuffix combinator. > <*> optionMaybe frameClause) > where > partitionBy = try (keyword_ "partition") >> -> keyword_ "by" >> commaSep1 scalarExpr' +> keyword_ "by" >> commaSep1 valueExpr' > frameClause = > mkFrame <$> choice [FrameRows <$ keyword_ "rows" > ,FrameRange <$ keyword_ "range"] @@ -208,7 +208,7 @@ always used with the optionSuffix combinator. > choice [UnboundedPreceding <$ keyword_ "preceding" > ,UnboundedFollowing <$ keyword_ "following"] > ,do -> e <- if useB then scalarExprB else scalarExpr +> e <- if useB then valueExprB else valueExpr > choice [Preceding e <$ keyword_ "preceding" > ,Following e <$ keyword_ "following"] > ] @@ -217,21 +217,21 @@ always used with the optionSuffix combinator. > mkFrame rs c = c rs > windowSuffix _ = fail "" -> app :: P ScalarExpr +> app :: P ValueExpr > app = aggOrApp >>= optionSuffix windowSuffix == case expression -> scase :: P ScalarExpr +> scase :: P ValueExpr > scase = -> Case <$> (try (keyword_ "case") *> optionMaybe (try scalarExpr')) +> Case <$> (try (keyword_ "case") *> optionMaybe (try valueExpr')) > <*> many1 swhen -> <*> optionMaybe (try (keyword_ "else") *> scalarExpr') +> <*> optionMaybe (try (keyword_ "else") *> valueExpr') > <* keyword_ "end" > where > swhen = keyword_ "when" *> -> ((,) <$> commaSep1 scalarExpr' -> <*> (keyword_ "then" *> scalarExpr')) +> ((,) <$> commaSep1 valueExpr' +> <*> (keyword_ "then" *> valueExpr')) == miscellaneous keyword operators @@ -242,11 +242,11 @@ to separate the arguments. cast: cast(expr as type) -> cast :: P ScalarExpr +> cast :: P ValueExpr > cast = parensCast <|> prefixCast > where > parensCast = try (keyword_ "cast") >> -> parens (Cast <$> scalarExpr' +> parens (Cast <$> valueExpr' > <*> (keyword_ "as" *> typeName)) > prefixCast = try (TypedLit <$> typeName > <*> stringLiteral) @@ -263,12 +263,12 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > -> SpecialOpKFirstArg -- has a first arg without a keyword > -> [(String,Bool)] -- the other args with their keywords > -- and whether they are optional -> -> P ScalarExpr +> -> P ValueExpr > specialOpK opName firstArg kws = > keyword_ opName >> do > void $ symbol "(" > let pfa = do -> e <- scalarExpr' +> e <- valueExpr' > -- check we haven't parsed the first > -- keyword as an identifier > guard (case (e,kws) of @@ -284,7 +284,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > return $ SpecialOpK (Name opName) fa $ catMaybes as > where > parseArg (nm,mand) = -> let p = keyword_ nm >> scalarExpr' +> let p = keyword_ nm >> valueExpr' > in fmap (nm,) <$> if mand > then Just <$> p > else optionMaybe (try p) @@ -309,31 +309,31 @@ TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ] target_string [COLLATE collation_name] ) -> specialOpKs :: P ScalarExpr +> specialOpKs :: P ValueExpr > specialOpKs = choice $ map try > [extract, position, substring, convert, translate, overlay, trim] -> extract :: P ScalarExpr +> extract :: P ValueExpr > extract = specialOpK "extract" SOKMandatory [("from", True)] -> position :: P ScalarExpr +> position :: P 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 :: P ScalarExpr +> substring :: P ValueExpr > substring = specialOpK "substring" SOKMandatory > [("from", False),("for", False),("collate", False)] -> convert :: P ScalarExpr +> convert :: P ValueExpr > convert = specialOpK "convert" SOKMandatory [("using", True)] -> translate :: P ScalarExpr +> translate :: P ValueExpr > translate = specialOpK "translate" SOKMandatory [("using", True)] -> overlay :: P ScalarExpr +> overlay :: P ValueExpr > overlay = specialOpK "overlay" SOKMandatory > [("placing", True),("from", True),("for", False)] @@ -341,13 +341,13 @@ 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 :: P ScalarExpr +> trim :: P ValueExpr > trim = > keyword "trim" >> > parens (mkTrim > <$> option "both" sides > <*> option " " stringLiteral -> <*> (keyword_ "from" *> scalarExpr') +> <*> (keyword_ "from" *> valueExpr') > <*> optionMaybe (keyword_ "collate" *> stringLiteral)) > where > sides = choice ["leading" <$ keyword_ "leading" @@ -363,13 +363,13 @@ in: two variations: a in (expr0, expr1, ...) a in (queryexpr) -> inSuffix :: ScalarExpr -> P ScalarExpr +> inSuffix :: ValueExpr -> P ValueExpr > inSuffix e = > In <$> inty > <*> return e > <*> parens (choice > [InQueryExpr <$> queryExpr -> ,InList <$> commaSep1 scalarExpr']) +> ,InList <$> commaSep1 valueExpr']) > where > inty = try $ choice [True <$ keyword_ "in" > ,False <$ keyword_ "not" <* keyword_ "in"] @@ -383,16 +383,16 @@ 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 +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 scalarExpr'' True. +and operator. This is the call to valueExpr'' True. -> betweenSuffix :: ScalarExpr -> P ScalarExpr +> betweenSuffix :: ValueExpr -> P ValueExpr > betweenSuffix e = > makeOp <$> (Name <$> opName) > <*> return e -> <*> scalarExpr'' True -> <*> (keyword_ "and" *> scalarExpr'' True) +> <*> valueExpr'' True +> <*> (keyword_ "and" *> valueExpr'' True) > where > opName = try $ choice > ["between" <$ keyword_ "between" @@ -402,7 +402,7 @@ and operator. This is the call to scalarExpr'' True. subquery expression: [exists|all|any|some] (queryexpr) -> subquery :: P ScalarExpr +> subquery :: P ValueExpr > subquery = > choice > [try $ SubQueryExpr SqSq <$> parens queryExpr @@ -453,11 +453,11 @@ todo: timestamp types: > makeWrap _ _ = fail "there must be one or two precision components" -== scalar parens and row ctor +== value expression parens and row ctor -> sparens :: P ScalarExpr +> sparens :: P ValueExpr > sparens = -> ctor <$> parens (commaSep1 scalarExpr') +> ctor <$> parens (commaSep1 valueExpr') > where > ctor [a] = Parens a > ctor as = SpecialOp (Name "rowctor") as @@ -521,9 +521,9 @@ supported. Maybe all these 'is's can be left factored? The parsers: -> prefixUnaryOp :: P ScalarExpr +> prefixUnaryOp :: P ValueExpr > prefixUnaryOp = -> PrefixOp <$> (Name <$> opSymbol) <*> scalarExpr' +> PrefixOp <$> (Name <$> opSymbol) <*> valueExpr' > where > opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames > ++ map (try . keyword) prefixUnOpKeywordNames) @@ -532,7 +532,7 @@ 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 :: ValueExpr -> P ValueExpr > postfixOpSuffix e = > try $ choice $ map makeOp opPairs > where @@ -543,7 +543,7 @@ both cases 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 :: Bool -> ValueExpr -> P ValueExpr > binaryOperatorSuffix bExpr e0 = > BinOp e0 <$> (Name <$> opSymbol) <*> factor > where @@ -586,17 +586,17 @@ associativity. This is fixed with a separate pass over the AST. > fName (Fixity n _) = n -== scalar expressions +== value expressions TODO: left factor stuff which starts with identifier -This parses most of the scalar exprs. I'm not sure if factor is the +This parses most of the value 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 :: P ValueExpr > factor = choice [literal > ,parameter > ,scase @@ -611,8 +611,8 @@ could at least do with some heavy explanation. putting the factor together with the extra bits -> scalarExpr'' :: Bool -> P ScalarExpr -> scalarExpr'' bExpr = factor >>= trysuffix +> valueExpr'' :: Bool -> P ValueExpr +> valueExpr'' bExpr = factor >>= trysuffix > where > trysuffix e = try (suffix e) <|> return e > suffix e0 = choice @@ -625,22 +625,22 @@ putting the factor together with the extra bits Wrapper for non 'bExpr' parsing. See the between parser for explanation. -> scalarExpr' :: P ScalarExpr -> scalarExpr' = scalarExpr'' False +> valueExpr' :: P ValueExpr +> valueExpr' = valueExpr'' 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 +The valueExpr wrapper. The idea is that directly nested value +expressions use the valueExpr' parser, then other code uses the +valueExpr parser and then everyone gets the fixity fixes and it's +easy to ensure that this fix is only applied once to each value expression tree (for efficiency and code clarity). -> scalarExpr :: P ScalarExpr -> scalarExpr = fixFixities sqlFixities <$> scalarExpr' +> valueExpr :: P ValueExpr +> valueExpr = fixFixities sqlFixities <$> valueExpr' expose the b expression for window frame clause range between -> scalarExprB :: P ScalarExpr -> scalarExprB = fixFixities sqlFixities <$> scalarExpr'' True +> valueExprB :: P ValueExpr +> valueExprB = fixFixities sqlFixities <$> valueExpr'' True ------------------------------------------------- @@ -649,11 +649,11 @@ expose the b expression for window frame clause range between == select lists -> selectItem :: P (Maybe Name, ScalarExpr) -> selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try als) +> selectItem :: P (Maybe Name, ValueExpr) +> selectItem = flip (,) <$> valueExpr <*> optionMaybe (try als) > where als = optional (try (keyword_ "as")) *> name -> selectList :: P [(Maybe Name,ScalarExpr)] +> selectList :: P [(Maybe Name,ValueExpr)] > selectList = commaSep1 selectItem == from @@ -674,7 +674,7 @@ tref > ,TRLateral <$> (try (keyword_ "lateral") > *> nonJoinTref) > ,try (TRFunction <$> name -> <*> parens (commaSep scalarExpr)) +> <*> parens (commaSep valueExpr)) > ,TRSimple <$> name] > >>= optionSuffix aliasSuffix > aliasSuffix j = option j (TRAlias j <$> alias) @@ -697,7 +697,7 @@ tref > joinCondition nat = > choice [guard nat >> return JoinNatural > ,try (keyword_ "on") >> -> JoinOn <$> scalarExpr +> JoinOn <$> valueExpr > ,try (keyword_ "using") >> > JoinUsing <$> parens (commaSep1 name) > ] @@ -716,11 +716,11 @@ 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 +> keywordValueExpr :: String -> P ValueExpr +> keywordValueExpr k = try (keyword_ k) *> valueExpr -> swhere :: P ScalarExpr -> swhere = keywordScalarExpr "where" +> swhere :: P ValueExpr +> swhere = keywordValueExpr "where" > sgroupBy :: P [GroupingExpr] > sgroupBy = try (keyword_ "group") @@ -736,17 +736,17 @@ where, having, limit, offset). > ,GroupingParens <$> parens (commaSep groupingExpression) > ,try (keyword_ "grouping") >> keyword_ "sets" >> > GroupingSets <$> parens (commaSep groupingExpression) -> ,SimpleGroup <$> scalarExpr +> ,SimpleGroup <$> valueExpr > ] -> having :: P ScalarExpr -> having = keywordScalarExpr "having" +> having :: P ValueExpr +> having = keywordValueExpr "having" > orderBy :: P [SortSpec] > orderBy = try (keyword_ "order") *> keyword_ "by" *> commaSep1 ob > where > ob = SortSpec -> <$> scalarExpr +> <$> valueExpr > <*> option Asc (choice [Asc <$ keyword_ "asc" > ,Desc <$ keyword_ "desc"]) > <*> option NullsOrderDefault @@ -757,23 +757,23 @@ where, having, limit, offset). allows offset and fetch in either order + postgresql offset without row(s) and limit instead of fetch also -> offsetFetch :: P (Maybe ScalarExpr, Maybe ScalarExpr) +> offsetFetch :: P (Maybe ValueExpr, Maybe ValueExpr) > offsetFetch = permute ((,) <$?> (Nothing, Just <$> offset) > <|?> (Nothing, Just <$> fetch)) -> offset :: P ScalarExpr -> offset = try (keyword_ "offset") *> scalarExpr +> offset :: P ValueExpr +> offset = try (keyword_ "offset") *> valueExpr > <* option () (try $ choice [try (keyword_ "rows"),keyword_ "row"]) -> fetch :: P ScalarExpr +> fetch :: P ValueExpr > fetch = choice [ansiFetch, limit] > where > ansiFetch = try (keyword_ "fetch") >> > choice [keyword_ "first",keyword_ "next"] -> *> scalarExpr +> *> valueExpr > <* choice [keyword_ "rows",keyword_ "row"] > <* keyword_ "only" -> limit = try (keyword_ "limit") *> scalarExpr +> limit = try (keyword_ "limit") *> valueExpr == common table expressions @@ -810,7 +810,7 @@ and union, etc.. > 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 scalarExpr)) +> >> Values <$> commaSep (parens (commaSep valueExpr)) > table = try (keyword_ "table") >> Table <$> name > queryExprSuffix :: QueryExpr -> P QueryExpr diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 0eff223..d239908 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -4,7 +4,7 @@ > -- readable way. > module Language.SQL.SimpleSQL.Pretty > (prettyQueryExpr -> ,prettyScalarExpr +> ,prettyValueExpr > ,prettyQueryExprs > ) where @@ -16,50 +16,50 @@ > prettyQueryExpr :: QueryExpr -> String > prettyQueryExpr = render . queryExpr -> -- | Convert a scalar expr ast to concrete syntax. -> prettyScalarExpr :: ScalarExpr -> String -> prettyScalarExpr = render . scalarExpr +> -- | Convert a value expr ast to concrete syntax. +> prettyValueExpr :: ValueExpr -> String +> prettyValueExpr = render . valueExpr > -- | 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 += value expressions -> scalarExpr :: ScalarExpr -> Doc -> scalarExpr (StringLit s) = quotes $ text $ doubleUpQuotes s +> valueExpr :: ValueExpr -> Doc +> valueExpr (StringLit s) = quotes $ text $ doubleUpQuotes s > where doubleUpQuotes [] = [] > doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs > doubleUpQuotes (c:cs) = c:doubleUpQuotes cs -> scalarExpr (NumLit s) = text s -> scalarExpr (IntervalLit v u p) = +> valueExpr (NumLit s) = text s +> valueExpr (IntervalLit v u p) = > text "interval" <+> quotes (text v) > <+> text u > <+> maybe empty (parens . text . show ) p -> scalarExpr (Iden i) = name i -> scalarExpr Star = text "*" -> scalarExpr Parameter = text "?" +> valueExpr (Iden i) = name i +> valueExpr Star = text "*" +> valueExpr Parameter = text "?" -> scalarExpr (App f es) = name f <> parens (commaSep (map scalarExpr es)) +> valueExpr (App f es) = name f <> parens (commaSep (map valueExpr es)) -> scalarExpr (AggregateApp f d es od) = +> valueExpr (AggregateApp f d es od) = > name f > <> parens ((case d of > Just Distinct -> text "distinct" > Just All -> text "all" > Nothing -> empty) -> <+> commaSep (map scalarExpr es) +> <+> commaSep (map valueExpr es) > <+> orderBy od) -> scalarExpr (WindowApp f es pb od fr) = -> name f <> parens (commaSep $ map scalarExpr es) +> valueExpr (WindowApp f es pb od fr) = +> name f <> parens (commaSep $ map valueExpr es) > <+> text "over" > <+> parens ((case pb of > [] -> empty > _ -> text "partition by" -> <+> nest 13 (commaSep $ map scalarExpr pb)) +> <+> nest 13 (commaSep $ map valueExpr pb)) > <+> orderBy od > <+> maybe empty frd fr) > where @@ -73,64 +73,64 @@ > fpd UnboundedPreceding = text "unbounded preceding" > fpd UnboundedFollowing = text "unbounded following" > fpd Current = text "current row" -> fpd (Preceding e) = scalarExpr e <+> text "preceding" -> fpd (Following e) = scalarExpr e <+> text "following" +> fpd (Preceding e) = valueExpr e <+> text "preceding" +> fpd (Following e) = valueExpr e <+> text "following" -> scalarExpr (SpecialOp nm [a,b,c]) | nm `elem` [Name "between" +> valueExpr (SpecialOp nm [a,b,c]) | nm `elem` [Name "between" > ,Name "not between"] = -> sep [scalarExpr a -> ,name nm <+> scalarExpr b -> ,nest (length (unname nm) + 1) $ text "and" <+> scalarExpr c] +> sep [valueExpr a +> ,name nm <+> valueExpr b +> ,nest (length (unname nm) + 1) $ text "and" <+> valueExpr c] -> scalarExpr (SpecialOp (Name "rowctor") as) = -> parens $ commaSep $ map scalarExpr as +> valueExpr (SpecialOp (Name "rowctor") as) = +> parens $ commaSep $ map valueExpr as -> scalarExpr (SpecialOp nm es) = -> name nm <+> parens (commaSep $ map scalarExpr es) +> valueExpr (SpecialOp nm es) = +> name nm <+> parens (commaSep $ map valueExpr es) -> scalarExpr (SpecialOpK nm fs as) = +> valueExpr (SpecialOpK nm fs as) = > name nm <> parens (sep $ catMaybes -> ((fmap scalarExpr fs) -> : map (\(n,e) -> Just (text n <+> scalarExpr e)) as)) +> ((fmap valueExpr fs) +> : map (\(n,e) -> Just (text n <+> valueExpr e)) as)) -> scalarExpr (PrefixOp f e) = name f <+> scalarExpr e -> scalarExpr (PostfixOp f e) = scalarExpr e <+> name f -> scalarExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] = +> 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"] = > -- 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 ((name op <+>) . scalarExpr) es) +> (e':es) -> vcat (valueExpr e' +> : map ((name 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 -> scalarExpr (BinOp e0 (Name ".") e1) = -> scalarExpr e0 <> text "." <> scalarExpr e1 -> scalarExpr (BinOp e0 f e1) = -> scalarExpr e0 <+> name f <+> scalarExpr e1 +> valueExpr (BinOp e0 (Name ".") e1) = +> valueExpr e0 <> text "." <> valueExpr e1 +> valueExpr (BinOp e0 f e1) = +> valueExpr e0 <+> name f <+> valueExpr e1 -> scalarExpr (Case t ws els) = -> sep $ [text "case" <+> maybe empty scalarExpr t] +> valueExpr (Case t ws els) = +> sep $ [text "case" <+> maybe empty valueExpr t] > ++ map w ws > ++ maybeToList (fmap e els) > ++ [text "end"] > where > w (t0,t1) = -> text "when" <+> nest 5 (commaSep $ map 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 tn) = -> text "cast" <> parens (sep [scalarExpr e +> text "when" <+> nest 5 (commaSep $ map valueExpr t0) +> <+> text "then" <+> nest 5 (valueExpr t1) +> e el = text "else" <+> nest 5 (valueExpr el) +> valueExpr (Parens e) = parens $ valueExpr e +> valueExpr (Cast e tn) = +> text "cast" <> parens (sep [valueExpr e > ,text "as" > ,typeName tn]) -> scalarExpr (TypedLit tn s) = +> valueExpr (TypedLit tn s) = > typeName tn <+> quotes (text s) -> scalarExpr (SubQueryExpr ty qe) = +> valueExpr (SubQueryExpr ty qe) = > (case ty of > SqSq -> empty > SqExists -> text "exists" @@ -139,13 +139,13 @@ > SqAny -> text "any" > ) <+> parens (queryExpr qe) -> scalarExpr (In b se x) = -> scalarExpr se <+> +> valueExpr (In b se x) = +> valueExpr 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 +> InList es -> commaSep $ map valueExpr es > InQueryExpr qe -> queryExpr qe) > unname :: Name -> String @@ -173,12 +173,12 @@ > Distinct -> text "distinct" > ,nest 7 $ sep [selectList sl] > ,from fr -> ,maybeScalarExpr "where" wh +> ,maybeValueExpr "where" wh > ,grpBy gb -> ,maybeScalarExpr "having" hv +> ,maybeValueExpr "having" hv > ,orderBy od -> ,maybe empty (\e -> text "offset" <+> scalarExpr e <+> text "rows") off -> ,maybe empty (\e -> text "fetch next" <+> scalarExpr e +> ,maybe empty (\e -> text "offset" <+> valueExpr e <+> text "rows") off +> ,maybe empty (\e -> text "fetch next" <+> valueExpr e > <+> text "rows only") fe > ] > queryExpr (CombineQueryExpr q1 ct d c q2) = @@ -202,7 +202,7 @@ > ,queryExpr qe] > queryExpr (Values vs) = > text "values" -> <+> nest 7 (commaSep (map (parens . commaSep . map scalarExpr) vs)) +> <+> nest 7 (commaSep (map (parens . commaSep . map valueExpr) vs)) > queryExpr (Table t) = text "table" <+> name t @@ -211,10 +211,10 @@ > text "as" <+> name nm > <+> maybe empty (parens . commaSep . map name) cols -> selectList :: [(Maybe Name, ScalarExpr)] -> Doc +> selectList :: [(Maybe Name, ValueExpr)] -> Doc > selectList is = commaSep $ map si is > where -> si (al,e) = scalarExpr e <+> maybe empty als al +> si (al,e) = valueExpr e <+> maybe empty als al > als al = text "as" <+> name al > from :: [TableRef] -> Doc @@ -226,7 +226,7 @@ > tr (TRSimple t) = name t > tr (TRLateral t) = text "lateral" <+> tr t > tr (TRFunction f as) = -> name f <> parens (commaSep $ map scalarExpr as) +> name 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 @@ -245,23 +245,23 @@ > JFull -> text "full" > JCross -> text "cross" > ,text "join"] -> joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e +> joinCond (Just (JoinOn e)) = text "on" <+> valueExpr e > joinCond (Just (JoinUsing es)) = > text "using" <+> parens (commaSep $ map name es) > joinCond Nothing = empty > joinCond (Just JoinNatural) = empty -> maybeScalarExpr :: String -> Maybe ScalarExpr -> Doc -> maybeScalarExpr k = maybe empty +> maybeValueExpr :: String -> Maybe ValueExpr -> Doc +> maybeValueExpr k = maybe empty > (\e -> sep [text k -> ,nest (length k + 1) $ scalarExpr e]) +> ,nest (length k + 1) $ valueExpr e]) > grpBy :: [GroupingExpr] -> Doc > grpBy [] = empty > grpBy gs = sep [text "group by" > ,nest 9 $ commaSep $ map ge gs] > where -> ge (SimpleGroup e) = scalarExpr e +> ge (SimpleGroup e) = valueExpr e > ge (GroupingParens g) = parens (commaSep $ map ge g) > ge (Cube es) = text "cube" <> parens (commaSep $ map ge es) > ge (Rollup es) = text "rollup" <> parens (commaSep $ map ge es) @@ -273,7 +273,7 @@ > ,nest 9 $ commaSep $ map f os] > where > f (SortSpec e d n) = -> scalarExpr e +> valueExpr e > <+> (if d == Asc then empty else text "desc") > <+> (case n of > NullsOrderDefault -> empty diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 2f749db..cb2dd80 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -1,8 +1,8 @@ > -- | The AST for SQL queries. > module Language.SQL.SimpleSQL.Syntax -> (-- * Scalar expressions -> ScalarExpr(..) +> (-- * Value expressions +> ValueExpr(..) > ,Name(..) > ,TypeName(..) > ,SetQuantifier(..) @@ -27,8 +27,10 @@ > ,JoinCondition(..) > ) where -> -- | Represents a scalar expression. -> data ScalarExpr + +> -- | Represents a value expression, i.e. expressions in select +> -- lists, where, group by, order by, etc. +> data ValueExpr > = -- | a numeric literal optional decimal point, e+- > -- integral exponent, e.g > -- @@ -60,13 +62,13 @@ > | Star > -- | function application (anything that looks like c style > -- function application syntactically) -> | App Name [ScalarExpr] +> | 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 -> ,aggArgs :: [ScalarExpr]-- ^ args +> ,aggArgs :: [ValueExpr]-- ^ args > ,aggOrderBy :: [SortSpec] -- ^ order by > } > -- | window application, which adds over (partition by a order @@ -74,54 +76,54 @@ > -- not currently supported > | WindowApp > {wnName :: Name -- ^ window function name -> ,wnArgs :: [ScalarExpr] -- ^ args -> ,wnPartition :: [ScalarExpr] -- ^ partition by +> ,wnArgs :: [ValueExpr] -- ^ args +> ,wnPartition :: [ValueExpr] -- ^ partition by > ,wnOrderBy :: [SortSpec] -- ^ order by > ,wnFrame :: Maybe Frame -- ^ frame clause > } > -- | Infix binary operators. This is used for symbol operators > -- (a + b), keyword operators (a and b) and multiple keyword > -- operators (a is similar to b) -> | BinOp ScalarExpr Name ScalarExpr +> | BinOp ValueExpr Name ValueExpr > -- | Prefix unary operators. This is used for symbol > -- operators, keyword operators and multiple keyword operators. -> | PrefixOp Name ScalarExpr +> | PrefixOp Name ValueExpr > -- | Postfix unary operators. This is used for symbol > -- operators, keyword operators and multiple keyword operators. -> | PostfixOp Name ScalarExpr +> | PostfixOp Name ValueExpr > -- | Used for ternary, mixfix and other non orthodox > -- operators. Currently used for row constructors, and for > -- between. -> | SpecialOp Name [ScalarExpr] +> | 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 ScalarExpr) [(String,ScalarExpr)] +> | SpecialOpK Name (Maybe ValueExpr) [(String,ValueExpr)] > -- | case expression. both flavours supported > | Case -> {caseTest :: Maybe ScalarExpr -- ^ test value -> ,caseWhens :: [([ScalarExpr],ScalarExpr)] -- ^ when branches -> ,caseElse :: Maybe ScalarExpr -- ^ else value +> {caseTest :: Maybe ValueExpr -- ^ test value +> ,caseWhens :: [([ValueExpr],ValueExpr)] -- ^ when branches +> ,caseElse :: Maybe ValueExpr -- ^ else value > } -> | Parens ScalarExpr +> | Parens ValueExpr > -- | cast(a as typename) -> | Cast ScalarExpr TypeName +> | Cast ValueExpr TypeName > -- | prefix 'typed literal', e.g. int '42' > | TypedLit TypeName String > -- | exists, all, any, some subqueries > | SubQueryExpr SubQueryExprType QueryExpr > -- | in list literal and in subquery, if the bool is false it > -- means not in was used ('a not in (1,2)') -> | In Bool ScalarExpr InPredValue +> | In Bool ValueExpr InPredValue > | Parameter -- ^ Represents a ? in a parameterized query > deriving (Eq,Show,Read) > -- | Represents an identifier name, which can be quoted or unquoted. > data Name = Name String > | QName String -> deriving (Eq,Show,Read) +> deriving (Eq,Show,Read) > -- | Represents a type name, used in casts. > data TypeName = TypeName String @@ -130,13 +132,13 @@ > deriving (Eq,Show,Read) -> -- | Used for 'expr in (scalar expression list)', and 'expr in +> -- | Used for 'expr in (value expression list)', and 'expr in > -- (subquery)' syntax. -> data InPredValue = InList [ScalarExpr] +> data InPredValue = InList [ValueExpr] > | InQueryExpr QueryExpr > deriving (Eq,Show,Read) -> -- | A subquery in a scalar expression. +> -- | A subquery in a value expression. > data SubQueryExprType > = -- | exists (query expr) > SqExists @@ -151,7 +153,7 @@ > deriving (Eq,Show,Read) > -- | Represents one field in an order by list. -> data SortSpec = SortSpec ScalarExpr Direction NullsOrder +> data SortSpec = SortSpec ValueExpr Direction NullsOrder > deriving (Eq,Show,Read) > -- | Represents 'nulls first' or 'nulls last' in an order by clause. @@ -173,9 +175,9 @@ > -- | represents the start or end of a frame > data FramePos = UnboundedPreceding -> | Preceding ScalarExpr +> | Preceding ValueExpr > | Current -> | Following ScalarExpr +> | Following ValueExpr > | UnboundedFollowing > deriving (Eq,Show,Read) @@ -194,7 +196,7 @@ > data QueryExpr > = Select > {qeSetQuantifier :: SetQuantifier -> ,qeSelectList :: [(Maybe Name,ScalarExpr)] +> ,qeSelectList :: [(Maybe Name,ValueExpr)] > -- ^ the column aliases and the expressions TODO: consider breaking this up. The SQL grammar has @@ -204,12 +206,12 @@ table expression = [where] [groupby] [having] ... This would make some things a bit cleaner? > ,qeFrom :: [TableRef] -> ,qeWhere :: Maybe ScalarExpr +> ,qeWhere :: Maybe ValueExpr > ,qeGroupBy :: [GroupingExpr] -> ,qeHaving :: Maybe ScalarExpr +> ,qeHaving :: Maybe ValueExpr > ,qeOrderBy :: [SortSpec] -> ,qeOffset :: Maybe ScalarExpr -> ,qeFetch :: Maybe ScalarExpr +> ,qeOffset :: Maybe ValueExpr +> ,qeFetch :: Maybe ValueExpr > } > | CombineQueryExpr > {qe0 :: QueryExpr @@ -222,7 +224,7 @@ This would make some things a bit cleaner? > {qeWithRecursive :: Bool > ,qeViews :: [(Alias,QueryExpr)] > ,qeQueryExpression :: QueryExpr} -> | Values [[ScalarExpr]] +> | Values [[ValueExpr]] > | Table Name > deriving (Eq,Show,Read) @@ -262,7 +264,7 @@ I'm not sure if this is valid syntax or not. > | Cube [GroupingExpr] > | Rollup [GroupingExpr] > | GroupingSets [GroupingExpr] -> | SimpleGroup ScalarExpr +> | SimpleGroup ValueExpr > deriving (Eq,Show,Read) > -- | Represents a entry in the csv of tables in the from clause. @@ -277,7 +279,7 @@ I'm not sure if this is valid syntax or not. > -- | from (query expr) > | TRQueryExpr QueryExpr > -- | from function(args) -> | TRFunction Name [ScalarExpr] +> | TRFunction Name [ValueExpr] > -- | from lateral t > | TRLateral TableRef > deriving (Eq,Show,Read) @@ -293,7 +295,7 @@ I'm not sure if this is valid syntax or not. > deriving (Eq,Show,Read) > -- | The join condition. -> data JoinCondition = JoinOn ScalarExpr -- ^ on expr +> data JoinCondition = JoinOn ValueExpr -- ^ on expr > | JoinUsing [Name] -- ^ using (column list) > | JoinNatural -- ^ natural join was used > deriving (Eq,Show,Read) diff --git a/TODO b/TODO index 720d94f..ed9613c 100644 --- a/TODO +++ b/TODO @@ -1,10 +1,21 @@ = next release -Most important goal is to replace the fixity code and fix all the bugs - here. Could also review parens and fixity at query expr level, and - in tablerefs +New fixity code + extensive tests. +check fixity in query expr level? +check fixity in tablerefs -== docs +release checklist: +hlint +haddock review +spell check +update changelog +update website text + += Later general tasks: + +---- + +docs add to website: pretty printed tpch, maybe other queries as demonstration @@ -14,7 +25,7 @@ add preamble to the rendered test page add links from the supported sql page to the rendered test page for each section -> have to section up the tests some more -== testing +testing review tests to copy from hssqlppp @@ -22,14 +33,13 @@ much more table reference tests, for joins and aliases etc.? review internal sql collection for more syntax/tests -== other +other change any/some/all to be proper infix operators like in ?? review syntax to replace maybe and bool with better ctors - -= Later general tasks: +---- demo program: convert tpch to sql server syntax exe processor diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index 8169085..83113c0 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -62,7 +62,7 @@ Test-Suite Tests Language.SQL.SimpleSQL.Postgres, Language.SQL.SimpleSQL.QueryExprComponents, Language.SQL.SimpleSQL.QueryExprs, - Language.SQL.SimpleSQL.ScalarExprs, + Language.SQL.SimpleSQL.ValueExprs, Language.SQL.SimpleSQL.TableRefs, Language.SQL.SimpleSQL.TestTypes, Language.SQL.SimpleSQL.Tests, diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs index 5e7fa47..8254c9c 100644 --- a/tools/Language/SQL/SimpleSQL/TestTypes.lhs +++ b/tools/Language/SQL/SimpleSQL/TestTypes.lhs @@ -9,7 +9,7 @@ Tests.lhs module for the 'interpreter'. > import Data.String > data TestItem = Group String [TestItem] -> | TestScalarExpr String ScalarExpr +> | TestValueExpr String ValueExpr > | TestQueryExpr String QueryExpr > | TestQueryExprs String [QueryExpr] diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs index 54349a1..6bf41c3 100644 --- a/tools/Language/SQL/SimpleSQL/Tests.lhs +++ b/tools/Language/SQL/SimpleSQL/Tests.lhs @@ -1,13 +1,7 @@ -TODO: - -split into multiple files: -scalar expressions -tablerefs -other queryexpr parts: not enough to split into multiple files -full queries -tpch tests - +This is the main tests module which exposes the test data plus the +Test.Framework tests. It also contains the code which converts the +test data to the Test.Framework tests. > module Language.SQL.SimpleSQL.Tests > (testData @@ -31,7 +25,7 @@ tpch tests > import Language.SQL.SimpleSQL.QueryExprComponents > import Language.SQL.SimpleSQL.QueryExprs > import Language.SQL.SimpleSQL.TableRefs -> import Language.SQL.SimpleSQL.ScalarExprs +> import Language.SQL.SimpleSQL.ValueExprs > import Language.SQL.SimpleSQL.Tpch @@ -42,7 +36,7 @@ order on the generated documentation. > testData :: TestItem > testData = > Group "parserTest" -> [scalarExprTests +> [valueExprTests > ,queryExprComponentTests > ,queryExprsTests > ,tableRefTests @@ -61,8 +55,8 @@ order on the generated documentation. > itemToTest :: TestItem -> Test.Framework.Test > itemToTest (Group nm ts) = > testGroup nm $ map itemToTest ts -> itemToTest (TestScalarExpr str expected) = -> toTest parseScalarExpr prettyScalarExpr str expected +> itemToTest (TestValueExpr str expected) = +> toTest parseValueExpr prettyValueExpr str expected > itemToTest (TestQueryExpr str expected) = > toTest parseQueryExpr prettyQueryExpr str expected > itemToTest (TestQueryExprs str expected) = diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs similarity index 91% rename from tools/Language/SQL/SimpleSQL/ScalarExprs.lhs rename to tools/Language/SQL/SimpleSQL/ValueExprs.lhs index 6c13b01..1a74e4c 100644 --- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs @@ -1,14 +1,14 @@ -Tests for parsing scalar expressions +Tests for parsing value expressions > {-# LANGUAGE OverloadedStrings #-} -> module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where +> module Language.SQL.SimpleSQL.ValueExprs (valueExprTests) where > import Language.SQL.SimpleSQL.TestTypes > import Language.SQL.SimpleSQL.Syntax -> scalarExprTests :: TestItem -> scalarExprTests = Group "scalarExprTests" +> valueExprTests :: TestItem +> valueExprTests = Group "valueExprTests" > [literals > ,identifiers > ,star @@ -24,7 +24,7 @@ Tests for parsing scalar expressions > ] > literals :: TestItem -> literals = Group "literals" $ map (uncurry TestScalarExpr) +> literals = Group "literals" $ map (uncurry TestValueExpr) > [("3", NumLit "3") > ,("3.", NumLit "3.") > ,("3.3", NumLit "3.3") @@ -44,27 +44,27 @@ Tests for parsing scalar expressions > ] > identifiers :: TestItem -> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr) +> identifiers = Group "identifiers" $ map (uncurry TestValueExpr) > [("iden1", Iden "iden1") > --,("t.a", Iden2 "t" "a") > ,("\"quoted identifier\"", Iden $ QName "quoted identifier") > ] > star :: TestItem -> star = Group "star" $ map (uncurry TestScalarExpr) +> star = Group "star" $ map (uncurry TestValueExpr) > [("*", Star) > --,("t.*", Star2 "t") > --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"]) > ] > parameter :: TestItem -> parameter = Group "parameter" $ map (uncurry TestScalarExpr) +> parameter = Group "parameter" $ map (uncurry TestValueExpr) > [("?", Parameter) > ] > dots :: TestItem -> dots = Group "dot" $ map (uncurry TestScalarExpr) +> 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")) @@ -72,14 +72,14 @@ Tests for parsing scalar expressions > ] > app :: TestItem -> app = Group "app" $ map (uncurry TestScalarExpr) +> app = Group "app" $ map (uncurry TestValueExpr) > [("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) +> caseexp = Group "caseexp" $ map (uncurry TestValueExpr) > [("case a when 1 then 2 end" > ,Case (Just $ Iden "a") [([NumLit "1"] > ,NumLit "2")] Nothing) @@ -115,7 +115,7 @@ Tests for parsing scalar expressions > ,miscOps] > binaryOperators :: TestItem -> binaryOperators = Group "binaryOperators" $ map (uncurry TestScalarExpr) +> binaryOperators = Group "binaryOperators" $ map (uncurry TestValueExpr) > [("a + b", BinOp (Iden "a") "+" (Iden "b")) > -- sanity check fixities > -- todo: add more fixity checking @@ -130,7 +130,7 @@ Tests for parsing scalar expressions > ] > unaryOperators :: TestItem -> unaryOperators = Group "unaryOperators" $ map (uncurry TestScalarExpr) +> unaryOperators = Group "unaryOperators" $ map (uncurry TestValueExpr) > [("not a", PrefixOp "not" $ Iden "a") > ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a") > ,("+a", PrefixOp "+" $ Iden "a") @@ -139,7 +139,7 @@ Tests for parsing scalar expressions > casts :: TestItem -> casts = Group "operators" $ map (uncurry TestScalarExpr) +> casts = Group "operators" $ map (uncurry TestValueExpr) > [("cast('1' as int)" > ,Cast (StringLit "1") $ TypeName "int") @@ -161,7 +161,7 @@ Tests for parsing scalar expressions > ] > subqueries :: TestItem -> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr) +> subqueries = Group "unaryOperators" $ map (uncurry TestValueExpr) > [("exists (select a from t)", SubQueryExpr SqExists ms) > ,("(select a from t)", SubQueryExpr SqSq ms) @@ -187,7 +187,7 @@ Tests for parsing scalar expressions > } > miscOps :: TestItem -> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr) +> miscOps = Group "unaryOperators" $ map (uncurry TestValueExpr) > [("a in (1,2,3)" > ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"]) @@ -324,7 +324,7 @@ target_string > ] > aggregates :: TestItem -> aggregates = Group "aggregates" $ map (uncurry TestScalarExpr) +> aggregates = Group "aggregates" $ map (uncurry TestValueExpr) > [("count(*)",App "count" [Star]) > ,("sum(a order by a)" @@ -339,7 +339,7 @@ target_string > ] > windowFunctions :: TestItem -> windowFunctions = Group "windowFunctions" $ map (uncurry TestScalarExpr) +> windowFunctions = Group "windowFunctions" $ map (uncurry TestValueExpr) > [("max(a) over ()", WindowApp "max" [Iden "a"] [] [] Nothing) > ,("count(*) over ()", WindowApp "count" [Star] [] [] Nothing) @@ -398,7 +398,7 @@ target_string > ] > parens :: TestItem -> parens = Group "parens" $ map (uncurry TestScalarExpr) +> parens = Group "parens" $ map (uncurry TestValueExpr) > [("(a)", Parens (Iden "a")) > ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b"))) > ]