starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

rename ScalarExpr -> ValueExpr which is slightly more standard, add notes on new fixity implementation

Browse source
This commit is contained in:
Jake Wheat 2013-12-19 11:46:51 +02:00
parent 88e968b261
commit 3b2730fd99
9 changed files with 285 additions and 242 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
Language/SQL/SimpleSQL/Fixity.lhs
View file

@ -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'). trees for the operator precedence and associativity (aka 'fixity').
It currently uses haskell-src-exts as a hack, the algorithm from there 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 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 #-} > {-# LANGUAGE TupleSections #-}
> module Language.SQL.SimpleSQL.Fixity > 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] > AssocRight -> HSE.infixr_ n [nm]
> AssocNone -> HSE.infix_ 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 fixed should be left associative and equal precedence to be fixed
correctly. It doesn't descend into query expressions in subqueries and 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 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). it should work on some of the other syntax (such as in).
> fixFixities :: [[Fixity]] -> ScalarExpr -> ScalarExpr > fixFixities :: [[Fixity]] -> ValueExpr -> ValueExpr
> fixFixities fs se = > fixFixities fs se =
> runIdentity $ toSql <$> HSE.applyFixities (toHSEFixity fs) (toHaskell 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 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 a strong stomach. Probably would have been less effort to just write
the fixity code. the fixity code.
> toHaskell :: ScalarExpr -> HSE.Exp > toHaskell :: ValueExpr -> HSE.Exp
> toHaskell e = case e of > toHaskell e = case e of
> BinOp e0 op e1 -> HSE.InfixApp > BinOp e0 op e1 -> HSE.InfixApp
> (toHaskell e0) > (toHaskell e0)
@ -128,7 +165,7 @@ the fixity code.
> toSql :: HSE.Exp -> ScalarExpr > toSql :: HSE.Exp -> ValueExpr
> toSql e = case e of > toSql e = case e of

180
Language/SQL/SimpleSQL/Parser.lhs
View file

@ -3,7 +3,7 @@
> -- | This is the module with the parser functions. > -- | This is the module with the parser functions.
> module Language.SQL.SimpleSQL.Parser > module Language.SQL.SimpleSQL.Parser
> (parseQueryExpr > (parseQueryExpr
> ,parseScalarExpr > ,parseValueExpr
> ,parseQueryExprs > ,parseQueryExprs
> ,ParseError(..)) where > ,ParseError(..)) where
@ -41,15 +41,15 @@ The public API functions.
> -> Either ParseError [QueryExpr] > -> Either ParseError [QueryExpr]
> parseQueryExprs = wrapParse queryExprs > parseQueryExprs = wrapParse queryExprs
> -- | Parses a scalar expression. > -- | Parses a value expression.
> parseScalarExpr :: FilePath > parseValueExpr :: FilePath
> -- ^ filename to use in errors > -- ^ filename to use in errors
> -> Maybe (Int,Int) > -> Maybe (Int,Int)
> -- ^ line number and column number to use in errors > -- ^ line number and column number to use in errors
> -> String > -> String
> -- ^ the SQL source to parse > -- ^ the SQL source to parse
> -> Either ParseError ScalarExpr > -> Either ParseError ValueExpr
> parseScalarExpr = wrapParse scalarExpr > parseValueExpr = wrapParse valueExpr
This helper function takes the parser given and: 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 > type P a = ParsecT String () Identity a
= scalar expressions = value expressions
== literals == literals
See the stringLiteral lexer below for notes on string literal syntax. See the stringLiteral lexer below for notes on string literal syntax.
> estring :: P ScalarExpr > estring :: P ValueExpr
> estring = StringLit <$> stringLiteral > estring = StringLit <$> stringLiteral
> number :: P ScalarExpr > number :: P ValueExpr
> number = NumLit <$> numberLiteral > number = NumLit <$> numberLiteral
parse SQL interval literals, something like 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' interval '3 days'
which parses as a typed literal which parses as a typed literal
> interval :: P ScalarExpr > interval :: P ValueExpr
> interval = try (keyword_ "interval" >> > interval = try (keyword_ "interval" >>
> IntervalLit > IntervalLit
> <$> stringLiteral > <$> stringLiteral
> <*> identifierString > <*> identifierString
> <*> optionMaybe (try $ parens integerLiteral)) > <*> optionMaybe (try $ parens integerLiteral))
> literal :: P ScalarExpr > literal :: P ValueExpr
> literal = number <|> estring <|> interval > literal = number <|> estring <|> interval
== identifiers == identifiers
@ -124,7 +124,7 @@ identifiers.
> name = choice [QName <$> quotedIdentifier > name = choice [QName <$> quotedIdentifier
> ,Name <$> identifierString] > ,Name <$> identifierString]
> identifier :: P ScalarExpr > identifier :: P ValueExpr
> identifier = Iden <$> name > identifier = Iden <$> name
== star == star
@ -132,34 +132,34 @@ identifiers.
used in select *, select x.*, and agg(*) variations, and some other used in select *, select x.*, and agg(*) variations, and some other
places as well. Because it is quite general, the parser doesn't 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 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 "*" > star = Star <$ symbol "*"
== parameter == parameter
use in e.g. select * from t where a = ? use in e.g. select * from t where a = ?
> parameter :: P ScalarExpr > parameter :: P ValueExpr
> parameter = Parameter <$ symbol "?" > parameter = Parameter <$ symbol "?"
== function application, aggregates and windows == function application, aggregates and windows
this represents anything which syntactically looks like regular C 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. expression arguments.
The parsing for the aggregate extensions is here as well: The parsing for the aggregate extensions is here as well:
aggregate([all|distinct] args [order by orderitems]) aggregate([all|distinct] args [order by orderitems])
> aggOrApp :: P ScalarExpr > aggOrApp :: P ValueExpr
> aggOrApp = > aggOrApp =
> makeApp > makeApp
> <$> name > <$> name
> <*> parens ((,,) <$> try duplicates > <*> parens ((,,) <$> try duplicates
> <*> choice [commaSep scalarExpr'] > <*> choice [commaSep valueExpr']
> <*> try (optionMaybe orderBy)) > <*> try (optionMaybe orderBy))
> where > where
> makeApp i (Nothing,es,Nothing) = App i es > 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 parser names means that they have been left factored. These are almost
always used with the optionSuffix combinator. always used with the optionSuffix combinator.
> windowSuffix :: ScalarExpr -> P ScalarExpr > windowSuffix :: ValueExpr -> P ValueExpr
> windowSuffix (App f es) = > windowSuffix (App f es) =
> try (keyword_ "over") > try (keyword_ "over")
> *> parens (WindowApp f es > *> parens (WindowApp f es
@ -189,7 +189,7 @@ always used with the optionSuffix combinator.
> <*> optionMaybe frameClause) > <*> optionMaybe frameClause)
> where > where
> partitionBy = try (keyword_ "partition") >> > partitionBy = try (keyword_ "partition") >>
> keyword_ "by" >> commaSep1 scalarExpr' > keyword_ "by" >> commaSep1 valueExpr'
> frameClause = > frameClause =
> mkFrame <$> choice [FrameRows <$ keyword_ "rows" > mkFrame <$> choice [FrameRows <$ keyword_ "rows"
> ,FrameRange <$ keyword_ "range"] > ,FrameRange <$ keyword_ "range"]
@ -208,7 +208,7 @@ always used with the optionSuffix combinator.
> choice [UnboundedPreceding <$ keyword_ "preceding" > choice [UnboundedPreceding <$ keyword_ "preceding"
> ,UnboundedFollowing <$ keyword_ "following"] > ,UnboundedFollowing <$ keyword_ "following"]
> ,do > ,do
> e <- if useB then scalarExprB else scalarExpr > e <- if useB then valueExprB else valueExpr
> choice [Preceding e <$ keyword_ "preceding" > choice [Preceding e <$ keyword_ "preceding"
> ,Following e <$ keyword_ "following"] > ,Following e <$ keyword_ "following"]
> ] > ]
@ -217,21 +217,21 @@ always used with the optionSuffix combinator.
> mkFrame rs c = c rs > mkFrame rs c = c rs
> windowSuffix _ = fail "" > windowSuffix _ = fail ""
> app :: P ScalarExpr > app :: P ValueExpr
> app = aggOrApp >>= optionSuffix windowSuffix > app = aggOrApp >>= optionSuffix windowSuffix
== case expression == case expression
> scase :: P ScalarExpr > scase :: P ValueExpr
> scase = > scase =
> Case <$> (try (keyword_ "case") *> optionMaybe (try scalarExpr')) > Case <$> (try (keyword_ "case") *> optionMaybe (try valueExpr'))
> <*> many1 swhen > <*> many1 swhen
> <*> optionMaybe (try (keyword_ "else") *> scalarExpr') > <*> optionMaybe (try (keyword_ "else") *> valueExpr')
> <* keyword_ "end" > <* keyword_ "end"
> where > where
> swhen = keyword_ "when" *> > swhen = keyword_ "when" *>
> ((,) <$> commaSep1 scalarExpr' > ((,) <$> commaSep1 valueExpr'
> <*> (keyword_ "then" *> scalarExpr')) > <*> (keyword_ "then" *> valueExpr'))
== miscellaneous keyword operators == miscellaneous keyword operators
@ -242,11 +242,11 @@ to separate the arguments.
cast: cast(expr as type) cast: cast(expr as type)
> cast :: P ScalarExpr > cast :: P ValueExpr
> cast = parensCast <|> prefixCast > cast = parensCast <|> prefixCast
> where > where
> parensCast = try (keyword_ "cast") >> > parensCast = try (keyword_ "cast") >>
> parens (Cast <$> scalarExpr' > parens (Cast <$> valueExpr'
> <*> (keyword_ "as" *> typeName)) > <*> (keyword_ "as" *> typeName))
> prefixCast = try (TypedLit <$> typeName > prefixCast = try (TypedLit <$> typeName
> <*> stringLiteral) > <*> stringLiteral)
@ -263,12 +263,12 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)
> -> SpecialOpKFirstArg -- has a first arg without a keyword > -> SpecialOpKFirstArg -- has a first arg without a keyword
> -> [(String,Bool)] -- the other args with their keywords > -> [(String,Bool)] -- the other args with their keywords
> -- and whether they are optional > -- and whether they are optional
> -> P ScalarExpr > -> P ValueExpr
> specialOpK opName firstArg kws = > specialOpK opName firstArg kws =
> keyword_ opName >> do > keyword_ opName >> do
> void $ symbol "(" > void $ symbol "("
> let pfa = do > let pfa = do
> e <- scalarExpr' > e <- valueExpr'
> -- check we haven't parsed the first > -- check we haven't parsed the first
> -- keyword as an identifier > -- keyword as an identifier
> guard (case (e,kws) of > guard (case (e,kws) of
@ -284,7 +284,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)
> return $ SpecialOpK (Name opName) fa $ catMaybes as > return $ SpecialOpK (Name opName) fa $ catMaybes as
> where > where
> parseArg (nm,mand) = > parseArg (nm,mand) =
> let p = keyword_ nm >> scalarExpr' > let p = keyword_ nm >> valueExpr'
> in fmap (nm,) <$> if mand > in fmap (nm,) <$> if mand
> then Just <$> p > then Just <$> p
> else optionMaybe (try p) > else optionMaybe (try p)
@ -309,31 +309,31 @@ TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
target_string target_string
[COLLATE collation_name] ) [COLLATE collation_name] )
> specialOpKs :: P ScalarExpr > specialOpKs :: P ValueExpr
> specialOpKs = choice $ map try > specialOpKs = choice $ map try
> [extract, position, substring, convert, translate, overlay, trim] > [extract, position, substring, convert, translate, overlay, trim]
> extract :: P ScalarExpr > extract :: P ValueExpr
> extract = specialOpK "extract" SOKMandatory [("from", True)] > extract = specialOpK "extract" SOKMandatory [("from", True)]
> position :: P ScalarExpr > position :: P ValueExpr
> position = specialOpK "position" SOKMandatory [("in", True)] > position = specialOpK "position" SOKMandatory [("in", True)]
strictly speaking, the substring must have at least one of from and strictly speaking, the substring must have at least one of from and
for, but the parser doens't enforce this for, but the parser doens't enforce this
> substring :: P ScalarExpr > substring :: P ValueExpr
> substring = specialOpK "substring" SOKMandatory > substring = specialOpK "substring" SOKMandatory
> [("from", False),("for", False),("collate", False)] > [("from", False),("for", False),("collate", False)]
> convert :: P ScalarExpr > convert :: P ValueExpr
> convert = specialOpK "convert" SOKMandatory [("using", True)] > convert = specialOpK "convert" SOKMandatory [("using", True)]
> translate :: P ScalarExpr > translate :: P ValueExpr
> translate = specialOpK "translate" SOKMandatory [("using", True)] > translate = specialOpK "translate" SOKMandatory [("using", True)]
> overlay :: P ScalarExpr > overlay :: P ValueExpr
> overlay = specialOpK "overlay" SOKMandatory > overlay = specialOpK "overlay" SOKMandatory
> [("placing", True),("from", True),("for", False)] > [("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 the both ' ' is filled in as the default if either parts are missing
in the source in the source
> trim :: P ScalarExpr > trim :: P ValueExpr
> trim = > trim =
> keyword "trim" >> > keyword "trim" >>
> parens (mkTrim > parens (mkTrim
> <$> option "both" sides > <$> option "both" sides
> <*> option " " stringLiteral > <*> option " " stringLiteral
> <*> (keyword_ "from" *> scalarExpr') > <*> (keyword_ "from" *> valueExpr')
> <*> optionMaybe (keyword_ "collate" *> stringLiteral)) > <*> optionMaybe (keyword_ "collate" *> stringLiteral))
> where > where
> sides = choice ["leading" <$ keyword_ "leading" > sides = choice ["leading" <$ keyword_ "leading"
@ -363,13 +363,13 @@ in: two variations:
a in (expr0, expr1, ...) a in (expr0, expr1, ...)
a in (queryexpr) a in (queryexpr)
> inSuffix :: ScalarExpr -> P ScalarExpr > inSuffix :: ValueExpr -> P ValueExpr
> inSuffix e = > inSuffix e =
> In <$> inty > In <$> inty
> <*> return e > <*> return e
> <*> parens (choice > <*> parens (choice
> [InQueryExpr <$> queryExpr > [InQueryExpr <$> queryExpr
> ,InList <$> commaSep1 scalarExpr']) > ,InList <$> commaSep1 valueExpr'])
> where > where
> inty = try $ choice [True <$ keyword_ "in" > inty = try $ choice [True <$ keyword_ "in"
> ,False <$ keyword_ "not" <* 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, postgres does, which might be standard across SQL implementations,
which is that you can't have a binary and operator in the middle 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 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 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 = > betweenSuffix e =
> makeOp <$> (Name <$> opName) > makeOp <$> (Name <$> opName)
> <*> return e > <*> return e
> <*> scalarExpr'' True > <*> valueExpr'' True
> <*> (keyword_ "and" *> scalarExpr'' True) > <*> (keyword_ "and" *> valueExpr'' True)
> where > where
> opName = try $ choice > opName = try $ choice
> ["between" <$ keyword_ "between" > ["between" <$ keyword_ "between"
@ -402,7 +402,7 @@ and operator. This is the call to scalarExpr'' True.
subquery expression: subquery expression:
[exists|all|any|some] (queryexpr) [exists|all|any|some] (queryexpr)
> subquery :: P ScalarExpr > subquery :: P ValueExpr
> subquery = > subquery =
> choice > choice
> [try $ SubQueryExpr SqSq <$> parens queryExpr > [try $ SubQueryExpr SqSq <$> parens queryExpr
@ -453,11 +453,11 @@ todo: timestamp types:
> makeWrap _ _ = fail "there must be one or two precision components" > 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 = > sparens =
> ctor <$> parens (commaSep1 scalarExpr') > ctor <$> parens (commaSep1 valueExpr')
> where > where
> ctor [a] = Parens a > ctor [a] = Parens a
> ctor as = SpecialOp (Name "rowctor") as > ctor as = SpecialOp (Name "rowctor") as
@ -521,9 +521,9 @@ supported. Maybe all these 'is's can be left factored?
The parsers: The parsers:
> prefixUnaryOp :: P ScalarExpr > prefixUnaryOp :: P ValueExpr
> prefixUnaryOp = > prefixUnaryOp =
> PrefixOp <$> (Name <$> opSymbol) <*> scalarExpr' > PrefixOp <$> (Name <$> opSymbol) <*> valueExpr'
> where > where
> opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames > opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames
> ++ map (try . keyword) prefixUnOpKeywordNames) > ++ 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 postfixopsuffix and binaryoperatorsuffix. It should be the same in
both cases both cases
> postfixOpSuffix :: ScalarExpr -> P ScalarExpr > postfixOpSuffix :: ValueExpr -> P ValueExpr
> postfixOpSuffix e = > postfixOpSuffix e =
> try $ choice $ map makeOp opPairs > try $ choice $ map makeOp opPairs
> where > where
@ -543,7 +543,7 @@ both cases
All the binary operators are parsed as same precedence and left All the binary operators are parsed as same precedence and left
associativity. This is fixed with a separate pass over the AST. associativity. This is fixed with a separate pass over the AST.
> binaryOperatorSuffix :: Bool -> ScalarExpr -> P ScalarExpr > binaryOperatorSuffix :: Bool -> ValueExpr -> P ValueExpr
> binaryOperatorSuffix bExpr e0 = > binaryOperatorSuffix bExpr e0 =
> BinOp e0 <$> (Name <$> opSymbol) <*> factor > BinOp e0 <$> (Name <$> opSymbol) <*> factor
> where > where
@ -586,17 +586,17 @@ associativity. This is fixed with a separate pass over the AST.
> fName (Fixity n _) = n > fName (Fixity n _) = n
== scalar expressions == value expressions
TODO: TODO:
left factor stuff which starts with identifier 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 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 carefully done to make everything work. It is a little fragile and
could at least do with some heavy explanation. could at least do with some heavy explanation.
> factor :: P ScalarExpr > factor :: P ValueExpr
> factor = choice [literal > factor = choice [literal
> ,parameter > ,parameter
> ,scase > ,scase
@ -611,8 +611,8 @@ could at least do with some heavy explanation.
putting the factor together with the extra bits putting the factor together with the extra bits
> scalarExpr'' :: Bool -> P ScalarExpr > valueExpr'' :: Bool -> P ValueExpr
> scalarExpr'' bExpr = factor >>= trysuffix > valueExpr'' bExpr = factor >>= trysuffix
> where > where
> trysuffix e = try (suffix e) <|> return e > trysuffix e = try (suffix e) <|> return e
> suffix e0 = choice > 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 Wrapper for non 'bExpr' parsing. See the between parser for
explanation. explanation.
> scalarExpr' :: P ScalarExpr > valueExpr' :: P ValueExpr
> scalarExpr' = scalarExpr'' False > valueExpr' = valueExpr'' False
The scalarExpr wrapper. The idea is that directly nested scalar The valueExpr wrapper. The idea is that directly nested value
expressions use the scalarExpr' parser, then other code uses the expressions use the valueExpr' parser, then other code uses the
scalarExpr parser and then everyone gets the fixity fixes and it's valueExpr parser and then everyone gets the fixity fixes and it's
easy to ensure that this fix is only applied once to each scalar easy to ensure that this fix is only applied once to each value
expression tree (for efficiency and code clarity). expression tree (for efficiency and code clarity).
> scalarExpr :: P ScalarExpr > valueExpr :: P ValueExpr
> scalarExpr = fixFixities sqlFixities <$> scalarExpr' > valueExpr = fixFixities sqlFixities <$> valueExpr'
expose the b expression for window frame clause range between expose the b expression for window frame clause range between
> scalarExprB :: P ScalarExpr > valueExprB :: P ValueExpr
> scalarExprB = fixFixities sqlFixities <$> scalarExpr'' True > valueExprB = fixFixities sqlFixities <$> valueExpr'' True
------------------------------------------------- -------------------------------------------------
@ -649,11 +649,11 @@ expose the b expression for window frame clause range between
== select lists == select lists
> selectItem :: P (Maybe Name, ScalarExpr) > selectItem :: P (Maybe Name, ValueExpr)
> selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try als) > selectItem = flip (,) <$> valueExpr <*> optionMaybe (try als)
> where als = optional (try (keyword_ "as")) *> name > where als = optional (try (keyword_ "as")) *> name
> selectList :: P [(Maybe Name,ScalarExpr)] > selectList :: P [(Maybe Name,ValueExpr)]
> selectList = commaSep1 selectItem > selectList = commaSep1 selectItem
== from == from
@ -674,7 +674,7 @@ tref
> ,TRLateral <$> (try (keyword_ "lateral") > ,TRLateral <$> (try (keyword_ "lateral")
> *> nonJoinTref) > *> nonJoinTref)
> ,try (TRFunction <$> name > ,try (TRFunction <$> name
> <*> parens (commaSep scalarExpr)) > <*> parens (commaSep valueExpr))
> ,TRSimple <$> name] > ,TRSimple <$> name]
> >>= optionSuffix aliasSuffix > >>= optionSuffix aliasSuffix
> aliasSuffix j = option j (TRAlias j <$> alias) > aliasSuffix j = option j (TRAlias j <$> alias)
@ -697,7 +697,7 @@ tref
> joinCondition nat = > joinCondition nat =
> choice [guard nat >> return JoinNatural > choice [guard nat >> return JoinNatural
> ,try (keyword_ "on") >> > ,try (keyword_ "on") >>
> JoinOn <$> scalarExpr > JoinOn <$> valueExpr
> ,try (keyword_ "using") >> > ,try (keyword_ "using") >>
> JoinUsing <$> parens (commaSep1 name) > JoinUsing <$> parens (commaSep1 name)
> ] > ]
@ -716,11 +716,11 @@ pretty trivial.
Here is a helper for parsing a few parts of the query expr (currently Here is a helper for parsing a few parts of the query expr (currently
where, having, limit, offset). where, having, limit, offset).
> keywordScalarExpr :: String -> P ScalarExpr > keywordValueExpr :: String -> P ValueExpr
> keywordScalarExpr k = try (keyword_ k) *> scalarExpr > keywordValueExpr k = try (keyword_ k) *> valueExpr
> swhere :: P ScalarExpr > swhere :: P ValueExpr
> swhere = keywordScalarExpr "where" > swhere = keywordValueExpr "where"
> sgroupBy :: P [GroupingExpr] > sgroupBy :: P [GroupingExpr]
> sgroupBy = try (keyword_ "group") > sgroupBy = try (keyword_ "group")
@ -736,17 +736,17 @@ where, having, limit, offset).
> ,GroupingParens <$> parens (commaSep groupingExpression) > ,GroupingParens <$> parens (commaSep groupingExpression)
> ,try (keyword_ "grouping") >> keyword_ "sets" >> > ,try (keyword_ "grouping") >> keyword_ "sets" >>
> GroupingSets <$> parens (commaSep groupingExpression) > GroupingSets <$> parens (commaSep groupingExpression)
> ,SimpleGroup <$> scalarExpr > ,SimpleGroup <$> valueExpr
> ] > ]
> having :: P ScalarExpr > having :: P ValueExpr
> having = keywordScalarExpr "having" > having = keywordValueExpr "having"
> orderBy :: P [SortSpec] > orderBy :: P [SortSpec]
> orderBy = try (keyword_ "order") *> keyword_ "by" *> commaSep1 ob > orderBy = try (keyword_ "order") *> keyword_ "by" *> commaSep1 ob
> where > where
> ob = SortSpec > ob = SortSpec
> <$> scalarExpr > <$> valueExpr
> <*> option Asc (choice [Asc <$ keyword_ "asc" > <*> option Asc (choice [Asc <$ keyword_ "asc"
> ,Desc <$ keyword_ "desc"]) > ,Desc <$ keyword_ "desc"])
> <*> option NullsOrderDefault > <*> option NullsOrderDefault
@ -757,23 +757,23 @@ where, having, limit, offset).
allows offset and fetch in either order allows offset and fetch in either order
+ postgresql offset without row(s) and limit instead of fetch also + 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) > offsetFetch = permute ((,) <$?> (Nothing, Just <$> offset)
> <|?> (Nothing, Just <$> fetch)) > <|?> (Nothing, Just <$> fetch))
> offset :: P ScalarExpr > offset :: P ValueExpr
> offset = try (keyword_ "offset") *> scalarExpr > offset = try (keyword_ "offset") *> valueExpr
> <* option () (try $ choice [try (keyword_ "rows"),keyword_ "row"]) > <* option () (try $ choice [try (keyword_ "rows"),keyword_ "row"])
> fetch :: P ScalarExpr > fetch :: P ValueExpr
> fetch = choice [ansiFetch, limit] > fetch = choice [ansiFetch, limit]
> where > where
> ansiFetch = try (keyword_ "fetch") >> > ansiFetch = try (keyword_ "fetch") >>
> choice [keyword_ "first",keyword_ "next"] > choice [keyword_ "first",keyword_ "next"]
> *> scalarExpr > *> valueExpr
> <* choice [keyword_ "rows",keyword_ "row"] > <* choice [keyword_ "rows",keyword_ "row"]
> <* keyword_ "only" > <* keyword_ "only"
> limit = try (keyword_ "limit") *> scalarExpr > limit = try (keyword_ "limit") *> valueExpr
== common table expressions == common table expressions
@ -810,7 +810,7 @@ and union, etc..
> mkSelect d sl f w g h od (ofs,fe) = > mkSelect d sl f w g h od (ofs,fe) =
> Select d sl f w g h od ofs fe > Select d sl f w g h od ofs fe
> values = try (keyword_ "values") > values = try (keyword_ "values")
> >> Values <$> commaSep (parens (commaSep scalarExpr)) > >> Values <$> commaSep (parens (commaSep valueExpr))
> table = try (keyword_ "table") >> Table <$> name > table = try (keyword_ "table") >> Table <$> name
> queryExprSuffix :: QueryExpr -> P QueryExpr > queryExprSuffix :: QueryExpr -> P QueryExpr

134
Language/SQL/SimpleSQL/Pretty.lhs
View file

@ -4,7 +4,7 @@
> -- readable way. > -- readable way.
> module Language.SQL.SimpleSQL.Pretty > module Language.SQL.SimpleSQL.Pretty
> (prettyQueryExpr > (prettyQueryExpr
> ,prettyScalarExpr > ,prettyValueExpr
> ,prettyQueryExprs > ,prettyQueryExprs
> ) where > ) where
@ -16,50 +16,50 @@
> prettyQueryExpr :: QueryExpr -> String > prettyQueryExpr :: QueryExpr -> String
> prettyQueryExpr = render . queryExpr > prettyQueryExpr = render . queryExpr
> -- | Convert a scalar expr ast to concrete syntax. > -- | Convert a value expr ast to concrete syntax.
> prettyScalarExpr :: ScalarExpr -> String > prettyValueExpr :: ValueExpr -> String
> prettyScalarExpr = render . scalarExpr > prettyValueExpr = render . valueExpr
> -- | Convert a list of query exprs to concrete syntax. A semi colon > -- | Convert a list of query exprs to concrete syntax. A semi colon
> -- is inserted after each query expr. > -- is inserted after each query expr.
> prettyQueryExprs :: [QueryExpr] -> String > prettyQueryExprs :: [QueryExpr] -> String
> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr) > prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr)
= scalar expressions = value expressions
> scalarExpr :: ScalarExpr -> Doc > valueExpr :: ValueExpr -> Doc
> scalarExpr (StringLit s) = quotes $ text $ doubleUpQuotes s > valueExpr (StringLit s) = quotes $ text $ doubleUpQuotes s
> where doubleUpQuotes [] = [] > where doubleUpQuotes [] = []
> doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs > doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs
> doubleUpQuotes (c:cs) = c:doubleUpQuotes cs > doubleUpQuotes (c:cs) = c:doubleUpQuotes cs
> scalarExpr (NumLit s) = text s > valueExpr (NumLit s) = text s
> scalarExpr (IntervalLit v u p) = > valueExpr (IntervalLit v u p) =
> text "interval" <+> quotes (text v) > text "interval" <+> quotes (text v)
> <+> text u > <+> text u
> <+> maybe empty (parens . text . show ) p > <+> maybe empty (parens . text . show ) p
> scalarExpr (Iden i) = name i > valueExpr (Iden i) = name i
> scalarExpr Star = text "*" > valueExpr Star = text "*"
> scalarExpr Parameter = 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 > name f
> <> parens ((case d of > <> parens ((case d of
> Just Distinct -> text "distinct" > Just Distinct -> text "distinct"
> Just All -> text "all" > Just All -> text "all"
> Nothing -> empty) > Nothing -> empty)
> <+> commaSep (map scalarExpr es) > <+> commaSep (map valueExpr es)
> <+> orderBy od) > <+> orderBy od)
> scalarExpr (WindowApp f es pb od fr) = > valueExpr (WindowApp f es pb od fr) =
> name f <> parens (commaSep $ map scalarExpr es) > name f <> parens (commaSep $ map valueExpr es)
> <+> text "over" > <+> text "over"
> <+> parens ((case pb of > <+> parens ((case pb of
> [] -> empty > [] -> empty
> _ -> text "partition by" > _ -> text "partition by"
> <+> nest 13 (commaSep $ map scalarExpr pb)) > <+> nest 13 (commaSep $ map valueExpr pb))
> <+> orderBy od > <+> orderBy od
> <+> maybe empty frd fr) > <+> maybe empty frd fr)
> where > where
@ -73,64 +73,64 @@
> fpd UnboundedPreceding = text "unbounded preceding" > fpd UnboundedPreceding = text "unbounded preceding"
> fpd UnboundedFollowing = text "unbounded following" > fpd UnboundedFollowing = text "unbounded following"
> fpd Current = text "current row" > fpd Current = text "current row"
> fpd (Preceding e) = scalarExpr e <+> text "preceding" > fpd (Preceding e) = valueExpr e <+> text "preceding"
> fpd (Following e) = scalarExpr e <+> text "following" > 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"] = > ,Name "not between"] =
> sep [scalarExpr a > sep [valueExpr a
> ,name nm <+> scalarExpr b > ,name nm <+> valueExpr b
> ,nest (length (unname nm) + 1) $ text "and" <+> scalarExpr c] > ,nest (length (unname nm) + 1) $ text "and" <+> valueExpr c]
> scalarExpr (SpecialOp (Name "rowctor") as) = > valueExpr (SpecialOp (Name "rowctor") as) =
> parens $ commaSep $ map scalarExpr as > parens $ commaSep $ map valueExpr as
> scalarExpr (SpecialOp nm es) = > valueExpr (SpecialOp nm es) =
> name nm <+> parens (commaSep $ map scalarExpr es) > name nm <+> parens (commaSep $ map valueExpr es)
> scalarExpr (SpecialOpK nm fs as) = > valueExpr (SpecialOpK nm fs as) =
> name nm <> parens (sep $ catMaybes > name nm <> parens (sep $ catMaybes
> ((fmap scalarExpr fs) > ((fmap valueExpr fs)
> : map (\(n,e) -> Just (text n <+> scalarExpr e)) as)) > : map (\(n,e) -> Just (text n <+> valueExpr e)) as))
> scalarExpr (PrefixOp f e) = name f <+> scalarExpr e > valueExpr (PrefixOp f e) = name f <+> valueExpr e
> scalarExpr (PostfixOp f e) = scalarExpr e <+> name f > valueExpr (PostfixOp f e) = valueExpr e <+> name f
> scalarExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] = > valueExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] =
> -- special case for and, or, get all the ands so we can vcat them > -- special case for and, or, get all the ands so we can vcat them
> -- nicely > -- nicely
> case ands e of > case ands e of
> (e':es) -> vcat (scalarExpr e' > (e':es) -> vcat (valueExpr e'
> : map ((name op <+>) . scalarExpr) es) > : map ((name op <+>) . valueExpr) es)
> [] -> empty -- shouldn't be possible > [] -> empty -- shouldn't be possible
> where > where
> ands (BinOp a op' b) | op == op' = ands a ++ ands b > ands (BinOp a op' b) | op == op' = ands a ++ ands b
> ands x = [x] > ands x = [x]
> -- special case for . we don't use whitespace > -- special case for . we don't use whitespace
> scalarExpr (BinOp e0 (Name ".") e1) = > valueExpr (BinOp e0 (Name ".") e1) =
> scalarExpr e0 <> text "." <> scalarExpr e1 > valueExpr e0 <> text "." <> valueExpr e1
> scalarExpr (BinOp e0 f e1) = > valueExpr (BinOp e0 f e1) =
> scalarExpr e0 <+> name f <+> scalarExpr e1 > valueExpr e0 <+> name f <+> valueExpr e1
> scalarExpr (Case t ws els) = > valueExpr (Case t ws els) =
> sep $ [text "case" <+> maybe empty scalarExpr t] > sep $ [text "case" <+> maybe empty valueExpr t]
> ++ map w ws > ++ map w ws
> ++ maybeToList (fmap e els) > ++ maybeToList (fmap e els)
> ++ [text "end"] > ++ [text "end"]
> where > where
> w (t0,t1) = > w (t0,t1) =
> text "when" <+> nest 5 (commaSep $ map scalarExpr t0) > text "when" <+> nest 5 (commaSep $ map valueExpr t0)
> <+> text "then" <+> nest 5 (scalarExpr t1) > <+> text "then" <+> nest 5 (valueExpr t1)
> e el = text "else" <+> nest 5 (scalarExpr el) > e el = text "else" <+> nest 5 (valueExpr el)
> scalarExpr (Parens e) = parens $ scalarExpr e > valueExpr (Parens e) = parens $ valueExpr e
> scalarExpr (Cast e tn) = > valueExpr (Cast e tn) =
> text "cast" <> parens (sep [scalarExpr e > text "cast" <> parens (sep [valueExpr e
> ,text "as" > ,text "as"
> ,typeName tn]) > ,typeName tn])
> scalarExpr (TypedLit tn s) = > valueExpr (TypedLit tn s) =
> typeName tn <+> quotes (text s) > typeName tn <+> quotes (text s)
> scalarExpr (SubQueryExpr ty qe) = > valueExpr (SubQueryExpr ty qe) =
> (case ty of > (case ty of
> SqSq -> empty > SqSq -> empty
> SqExists -> text "exists" > SqExists -> text "exists"
@ -139,13 +139,13 @@
> SqAny -> text "any" > SqAny -> text "any"
> ) <+> parens (queryExpr qe) > ) <+> parens (queryExpr qe)
> scalarExpr (In b se x) = > valueExpr (In b se x) =
> scalarExpr se <+> > valueExpr se <+>
> (if b then empty else text "not") > (if b then empty else text "not")
> <+> text "in" > <+> text "in"
> <+> parens (nest (if b then 3 else 7) $ > <+> parens (nest (if b then 3 else 7) $
> case x of > case x of
> InList es -> commaSep $ map scalarExpr es > InList es -> commaSep $ map valueExpr es
> InQueryExpr qe -> queryExpr qe) > InQueryExpr qe -> queryExpr qe)
> unname :: Name -> String > unname :: Name -> String
@ -173,12 +173,12 @@
> Distinct -> text "distinct" > Distinct -> text "distinct"
> ,nest 7 $ sep [selectList sl] > ,nest 7 $ sep [selectList sl]
> ,from fr > ,from fr
> ,maybeScalarExpr "where" wh > ,maybeValueExpr "where" wh
> ,grpBy gb > ,grpBy gb
> ,maybeScalarExpr "having" hv > ,maybeValueExpr "having" hv
> ,orderBy od > ,orderBy od
> ,maybe empty (\e -> text "offset" <+> scalarExpr e <+> text "rows") off > ,maybe empty (\e -> text "offset" <+> valueExpr e <+> text "rows") off
> ,maybe empty (\e -> text "fetch next" <+> scalarExpr e > ,maybe empty (\e -> text "fetch next" <+> valueExpr e
> <+> text "rows only") fe > <+> text "rows only") fe
> ] > ]
> queryExpr (CombineQueryExpr q1 ct d c q2) = > queryExpr (CombineQueryExpr q1 ct d c q2) =
@ -202,7 +202,7 @@
> ,queryExpr qe] > ,queryExpr qe]
> queryExpr (Values vs) = > queryExpr (Values vs) =
> text "values" > 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 > queryExpr (Table t) = text "table" <+> name t
@ -211,10 +211,10 @@
> text "as" <+> name nm > text "as" <+> name nm
> <+> maybe empty (parens . commaSep . map name) cols > <+> maybe empty (parens . commaSep . map name) cols
> selectList :: [(Maybe Name, ScalarExpr)] -> Doc > selectList :: [(Maybe Name, ValueExpr)] -> Doc
> selectList is = commaSep $ map si is > selectList is = commaSep $ map si is
> where > 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 > als al = text "as" <+> name al
> from :: [TableRef] -> Doc > from :: [TableRef] -> Doc
@ -226,7 +226,7 @@
> tr (TRSimple t) = name t > tr (TRSimple t) = name t
> tr (TRLateral t) = text "lateral" <+> tr t > tr (TRLateral t) = text "lateral" <+> tr t
> tr (TRFunction f as) = > 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 (TRAlias t a) = sep [tr t, alias a]
> tr (TRParens t) = parens $ tr t > tr (TRParens t) = parens $ tr t
> tr (TRQueryExpr q) = parens $ queryExpr q > tr (TRQueryExpr q) = parens $ queryExpr q
@ -245,23 +245,23 @@
> JFull -> text "full" > JFull -> text "full"
> JCross -> text "cross" > JCross -> text "cross"
> ,text "join"] > ,text "join"]
> joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e > joinCond (Just (JoinOn e)) = text "on" <+> valueExpr e
> joinCond (Just (JoinUsing es)) = > joinCond (Just (JoinUsing es)) =
> text "using" <+> parens (commaSep $ map name es) > text "using" <+> parens (commaSep $ map name es)
> joinCond Nothing = empty > joinCond Nothing = empty
> joinCond (Just JoinNatural) = empty > joinCond (Just JoinNatural) = empty
> maybeScalarExpr :: String -> Maybe ScalarExpr -> Doc > maybeValueExpr :: String -> Maybe ValueExpr -> Doc
> maybeScalarExpr k = maybe empty > maybeValueExpr k = maybe empty
> (\e -> sep [text k > (\e -> sep [text k
> ,nest (length k + 1) $ scalarExpr e]) > ,nest (length k + 1) $ valueExpr e])
> grpBy :: [GroupingExpr] -> Doc > grpBy :: [GroupingExpr] -> Doc
> grpBy [] = empty > grpBy [] = empty
> grpBy gs = sep [text "group by" > grpBy gs = sep [text "group by"
> ,nest 9 $ commaSep $ map ge gs] > ,nest 9 $ commaSep $ map ge gs]
> where > where
> ge (SimpleGroup e) = scalarExpr e > ge (SimpleGroup e) = valueExpr e
> ge (GroupingParens g) = parens (commaSep $ map ge g) > ge (GroupingParens g) = parens (commaSep $ map ge g)
> ge (Cube es) = text "cube" <> parens (commaSep $ map ge es) > ge (Cube es) = text "cube" <> parens (commaSep $ map ge es)
> ge (Rollup es) = text "rollup" <> 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] > ,nest 9 $ commaSep $ map f os]
> where > where
> f (SortSpec e d n) = > f (SortSpec e d n) =
> scalarExpr e > valueExpr e
> <+> (if d == Asc then empty else text "desc") > <+> (if d == Asc then empty else text "desc")
> <+> (case n of > <+> (case n of
> NullsOrderDefault -> empty > NullsOrderDefault -> empty

70
Language/SQL/SimpleSQL/Syntax.lhs
View file

@ -1,8 +1,8 @@
> -- | The AST for SQL queries. > -- | The AST for SQL queries.
> module Language.SQL.SimpleSQL.Syntax > module Language.SQL.SimpleSQL.Syntax
> (-- * Scalar expressions > (-- * Value expressions
> ScalarExpr(..) > ValueExpr(..)
> ,Name(..) > ,Name(..)
> ,TypeName(..) > ,TypeName(..)
> ,SetQuantifier(..) > ,SetQuantifier(..)
@ -27,8 +27,10 @@
> ,JoinCondition(..) > ,JoinCondition(..)
> ) where > ) 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+- > = -- | a numeric literal optional decimal point, e+-
> -- integral exponent, e.g > -- integral exponent, e.g
> -- > --
@ -60,13 +62,13 @@
> | Star > | Star
> -- | function application (anything that looks like c style > -- | function application (anything that looks like c style
> -- function application syntactically) > -- function application syntactically)
> | App Name [ScalarExpr] > | App Name [ValueExpr]
> -- | aggregate application, which adds distinct or all, and > -- | aggregate application, which adds distinct or all, and
> -- order by, to regular function application > -- order by, to regular function application
> | AggregateApp > | AggregateApp
> {aggName :: Name -- ^ aggregate function name > {aggName :: Name -- ^ aggregate function name
> ,aggDistinct :: Maybe SetQuantifier -- ^ distinct > ,aggDistinct :: Maybe SetQuantifier -- ^ distinct
> ,aggArgs :: [ScalarExpr]-- ^ args > ,aggArgs :: [ValueExpr]-- ^ args
> ,aggOrderBy :: [SortSpec] -- ^ order by > ,aggOrderBy :: [SortSpec] -- ^ order by
> } > }
> -- | window application, which adds over (partition by a order > -- | window application, which adds over (partition by a order
@ -74,47 +76,47 @@
> -- not currently supported > -- not currently supported
> | WindowApp > | WindowApp
> {wnName :: Name -- ^ window function name > {wnName :: Name -- ^ window function name
> ,wnArgs :: [ScalarExpr] -- ^ args > ,wnArgs :: [ValueExpr] -- ^ args
> ,wnPartition :: [ScalarExpr] -- ^ partition by > ,wnPartition :: [ValueExpr] -- ^ partition by
> ,wnOrderBy :: [SortSpec] -- ^ order by > ,wnOrderBy :: [SortSpec] -- ^ order by
> ,wnFrame :: Maybe Frame -- ^ frame clause > ,wnFrame :: Maybe Frame -- ^ frame clause
> } > }
> -- | Infix binary operators. This is used for symbol operators > -- | Infix binary operators. This is used for symbol operators
> -- (a + b), keyword operators (a and b) and multiple keyword > -- (a + b), keyword operators (a and b) and multiple keyword
> -- operators (a is similar to b) > -- operators (a is similar to b)
> | BinOp ScalarExpr Name ScalarExpr > | BinOp ValueExpr Name ValueExpr
> -- | Prefix unary operators. This is used for symbol > -- | Prefix unary operators. This is used for symbol
> -- operators, keyword operators and multiple keyword operators. > -- operators, keyword operators and multiple keyword operators.
> | PrefixOp Name ScalarExpr > | PrefixOp Name ValueExpr
> -- | Postfix unary operators. This is used for symbol > -- | Postfix unary operators. This is used for symbol
> -- operators, keyword operators and multiple keyword operators. > -- operators, keyword operators and multiple keyword operators.
> | PostfixOp Name ScalarExpr > | PostfixOp Name ValueExpr
> -- | Used for ternary, mixfix and other non orthodox > -- | Used for ternary, mixfix and other non orthodox
> -- operators. Currently used for row constructors, and for > -- operators. Currently used for row constructors, and for
> -- between. > -- between.
> | SpecialOp Name [ScalarExpr] > | SpecialOp Name [ValueExpr]
> -- | Used for the operators which look like functions > -- | Used for the operators which look like functions
> -- except the arguments are separated by keywords instead > -- except the arguments are separated by keywords instead
> -- of commas. The maybe is for the first unnamed argument > -- of commas. The maybe is for the first unnamed argument
> -- if it is present, and the list is for the keyword argument > -- if it is present, and the list is for the keyword argument
> -- pairs. > -- pairs.
> | SpecialOpK Name (Maybe ScalarExpr) [(String,ScalarExpr)] > | SpecialOpK Name (Maybe ValueExpr) [(String,ValueExpr)]
> -- | case expression. both flavours supported > -- | case expression. both flavours supported
> | Case > | Case
> {caseTest :: Maybe ScalarExpr -- ^ test value > {caseTest :: Maybe ValueExpr -- ^ test value
> ,caseWhens :: [([ScalarExpr],ScalarExpr)] -- ^ when branches > ,caseWhens :: [([ValueExpr],ValueExpr)] -- ^ when branches
> ,caseElse :: Maybe ScalarExpr -- ^ else value > ,caseElse :: Maybe ValueExpr -- ^ else value
> } > }
> | Parens ScalarExpr > | Parens ValueExpr
> -- | cast(a as typename) > -- | cast(a as typename)
> | Cast ScalarExpr TypeName > | Cast ValueExpr TypeName
> -- | prefix 'typed literal', e.g. int '42' > -- | prefix 'typed literal', e.g. int '42'
> | TypedLit TypeName String > | TypedLit TypeName String
> -- | exists, all, any, some subqueries > -- | exists, all, any, some subqueries
> | SubQueryExpr SubQueryExprType QueryExpr > | SubQueryExpr SubQueryExprType QueryExpr
> -- | in list literal and in subquery, if the bool is false it > -- | in list literal and in subquery, if the bool is false it
> -- means not in was used ('a not in (1,2)') > -- 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 > | Parameter -- ^ Represents a ? in a parameterized query
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
@ -130,13 +132,13 @@
> deriving (Eq,Show,Read) > 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. > -- (subquery)' syntax.
> data InPredValue = InList [ScalarExpr] > data InPredValue = InList [ValueExpr]
> | InQueryExpr QueryExpr > | InQueryExpr QueryExpr
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
> -- | A subquery in a scalar expression. > -- | A subquery in a value expression.
> data SubQueryExprType > data SubQueryExprType
> = -- | exists (query expr) > = -- | exists (query expr)
> SqExists > SqExists
@ -151,7 +153,7 @@
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
> -- | Represents one field in an order by list. > -- | Represents one field in an order by list.
> data SortSpec = SortSpec ScalarExpr Direction NullsOrder > data SortSpec = SortSpec ValueExpr Direction NullsOrder
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
> -- | Represents 'nulls first' or 'nulls last' in an order by clause. > -- | Represents 'nulls first' or 'nulls last' in an order by clause.
@ -173,9 +175,9 @@
> -- | represents the start or end of a frame > -- | represents the start or end of a frame
> data FramePos = UnboundedPreceding > data FramePos = UnboundedPreceding
> | Preceding ScalarExpr > | Preceding ValueExpr
> | Current > | Current
> | Following ScalarExpr > | Following ValueExpr
> | UnboundedFollowing > | UnboundedFollowing
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
@ -194,7 +196,7 @@
> data QueryExpr > data QueryExpr
> = Select > = Select
> {qeSetQuantifier :: SetQuantifier > {qeSetQuantifier :: SetQuantifier
> ,qeSelectList :: [(Maybe Name,ScalarExpr)] > ,qeSelectList :: [(Maybe Name,ValueExpr)]
> -- ^ the column aliases and the expressions > -- ^ the column aliases and the expressions
TODO: consider breaking this up. The SQL grammar has TODO: consider breaking this up. The SQL grammar has
@ -204,12 +206,12 @@ table expression = <from> [where] [groupby] [having] ...
This would make some things a bit cleaner? This would make some things a bit cleaner?
> ,qeFrom :: [TableRef] > ,qeFrom :: [TableRef]
> ,qeWhere :: Maybe ScalarExpr > ,qeWhere :: Maybe ValueExpr
> ,qeGroupBy :: [GroupingExpr] > ,qeGroupBy :: [GroupingExpr]
> ,qeHaving :: Maybe ScalarExpr > ,qeHaving :: Maybe ValueExpr
> ,qeOrderBy :: [SortSpec] > ,qeOrderBy :: [SortSpec]
> ,qeOffset :: Maybe ScalarExpr > ,qeOffset :: Maybe ValueExpr
> ,qeFetch :: Maybe ScalarExpr > ,qeFetch :: Maybe ValueExpr
> } > }
> | CombineQueryExpr > | CombineQueryExpr
> {qe0 :: QueryExpr > {qe0 :: QueryExpr
@ -222,7 +224,7 @@ This would make some things a bit cleaner?
> {qeWithRecursive :: Bool > {qeWithRecursive :: Bool
> ,qeViews :: [(Alias,QueryExpr)] > ,qeViews :: [(Alias,QueryExpr)]
> ,qeQueryExpression :: QueryExpr} > ,qeQueryExpression :: QueryExpr}
> | Values [[ScalarExpr]] > | Values [[ValueExpr]]
> | Table Name > | Table Name
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
@ -262,7 +264,7 @@ I'm not sure if this is valid syntax or not.
> | Cube [GroupingExpr] > | Cube [GroupingExpr]
> | Rollup [GroupingExpr] > | Rollup [GroupingExpr]
> | GroupingSets [GroupingExpr] > | GroupingSets [GroupingExpr]
> | SimpleGroup ScalarExpr > | SimpleGroup ValueExpr
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
> -- | Represents a entry in the csv of tables in the from clause. > -- | 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) > -- | from (query expr)
> | TRQueryExpr QueryExpr > | TRQueryExpr QueryExpr
> -- | from function(args) > -- | from function(args)
> | TRFunction Name [ScalarExpr] > | TRFunction Name [ValueExpr]
> -- | from lateral t > -- | from lateral t
> | TRLateral TableRef > | TRLateral TableRef
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
@ -293,7 +295,7 @@ I'm not sure if this is valid syntax or not.
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)
> -- | The join condition. > -- | The join condition.
> data JoinCondition = JoinOn ScalarExpr -- ^ on expr > data JoinCondition = JoinOn ValueExpr -- ^ on expr
> | JoinUsing [Name] -- ^ using (column list) > | JoinUsing [Name] -- ^ using (column list)
> | JoinNatural -- ^ natural join was used > | JoinNatural -- ^ natural join was used
> deriving (Eq,Show,Read) > deriving (Eq,Show,Read)

26
TODO
View file

@ -1,10 +1,21 @@
= next release = next release
Most important goal is to replace the fixity code and fix all the bugs New fixity code + extensive tests.
here. Could also review parens and fixity at query expr level, and check fixity in query expr level?
in tablerefs 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 add to website: pretty printed tpch, maybe other queries as
demonstration 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 add links from the supported sql page to the rendered test page for
each section -> have to section up the tests some more each section -> have to section up the tests some more
== testing testing
review tests to copy from hssqlppp 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 review internal sql collection for more syntax/tests
== other other
change any/some/all to be proper infix operators like in ?? change any/some/all to be proper infix operators like in ??
review syntax to replace maybe and bool with better ctors review syntax to replace maybe and bool with better ctors
----
= Later general tasks:
demo program: convert tpch to sql server syntax exe processor demo program: convert tpch to sql server syntax exe processor

2
simple-sql-parser.cabal
View file

@ -62,7 +62,7 @@ Test-Suite Tests
Language.SQL.SimpleSQL.Postgres, Language.SQL.SimpleSQL.Postgres,
Language.SQL.SimpleSQL.QueryExprComponents, Language.SQL.SimpleSQL.QueryExprComponents,
Language.SQL.SimpleSQL.QueryExprs, Language.SQL.SimpleSQL.QueryExprs,
Language.SQL.SimpleSQL.ScalarExprs, Language.SQL.SimpleSQL.ValueExprs,
Language.SQL.SimpleSQL.TableRefs, Language.SQL.SimpleSQL.TableRefs,
Language.SQL.SimpleSQL.TestTypes, Language.SQL.SimpleSQL.TestTypes,
Language.SQL.SimpleSQL.Tests, Language.SQL.SimpleSQL.Tests,

2
tools/Language/SQL/SimpleSQL/TestTypes.lhs
View file

@ -9,7 +9,7 @@ Tests.lhs module for the 'interpreter'.
> import Data.String > import Data.String
> data TestItem = Group String [TestItem] > data TestItem = Group String [TestItem]
> | TestScalarExpr String ScalarExpr > | TestValueExpr String ValueExpr
> | TestQueryExpr String QueryExpr > | TestQueryExpr String QueryExpr
> | TestQueryExprs String [QueryExpr] > | TestQueryExprs String [QueryExpr]

20
tools/Language/SQL/SimpleSQL/Tests.lhs
View file

@ -1,13 +1,7 @@
TODO: This is the main tests module which exposes the test data plus the
Test.Framework tests. It also contains the code which converts the
split into multiple files: test data to the Test.Framework tests.
scalar expressions
tablerefs
other queryexpr parts: not enough to split into multiple files
full queries
tpch tests
> module Language.SQL.SimpleSQL.Tests > module Language.SQL.SimpleSQL.Tests
> (testData > (testData
@ -31,7 +25,7 @@ tpch tests
> import Language.SQL.SimpleSQL.QueryExprComponents > import Language.SQL.SimpleSQL.QueryExprComponents
> import Language.SQL.SimpleSQL.QueryExprs > import Language.SQL.SimpleSQL.QueryExprs
> import Language.SQL.SimpleSQL.TableRefs > import Language.SQL.SimpleSQL.TableRefs
> import Language.SQL.SimpleSQL.ScalarExprs > import Language.SQL.SimpleSQL.ValueExprs
> import Language.SQL.SimpleSQL.Tpch > import Language.SQL.SimpleSQL.Tpch
@ -42,7 +36,7 @@ order on the generated documentation.
> testData :: TestItem > testData :: TestItem
> testData = > testData =
> Group "parserTest" > Group "parserTest"
> [scalarExprTests > [valueExprTests
> ,queryExprComponentTests > ,queryExprComponentTests
> ,queryExprsTests > ,queryExprsTests
> ,tableRefTests > ,tableRefTests
@ -61,8 +55,8 @@ order on the generated documentation.
> itemToTest :: TestItem -> Test.Framework.Test > itemToTest :: TestItem -> Test.Framework.Test
> itemToTest (Group nm ts) = > itemToTest (Group nm ts) =
> testGroup nm $ map itemToTest ts > testGroup nm $ map itemToTest ts
> itemToTest (TestScalarExpr str expected) = > itemToTest (TestValueExpr str expected) =
> toTest parseScalarExpr prettyScalarExpr str expected > toTest parseValueExpr prettyValueExpr str expected
> itemToTest (TestQueryExpr str expected) = > itemToTest (TestQueryExpr str expected) =
> toTest parseQueryExpr prettyQueryExpr str expected > toTest parseQueryExpr prettyQueryExpr str expected
> itemToTest (TestQueryExprs str expected) = > itemToTest (TestQueryExprs str expected) =

38
tools/Language/SQL/SimpleSQL/ScalarExprs.lhs → tools/Language/SQL/SimpleSQL/ValueExprs.lhs
View file

@ -1,14 +1,14 @@
Tests for parsing scalar expressions Tests for parsing value expressions
> {-# LANGUAGE OverloadedStrings #-} > {-# 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.TestTypes
> import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Syntax
> scalarExprTests :: TestItem > valueExprTests :: TestItem
> scalarExprTests = Group "scalarExprTests" > valueExprTests = Group "valueExprTests"
> [literals > [literals
> ,identifiers > ,identifiers
> ,star > ,star
@ -24,7 +24,7 @@ Tests for parsing scalar expressions
> ] > ]
> literals :: TestItem > literals :: TestItem
> literals = Group "literals" $ map (uncurry TestScalarExpr) > literals = Group "literals" $ map (uncurry TestValueExpr)
> [("3", NumLit "3") > [("3", NumLit "3")
> ,("3.", NumLit "3.") > ,("3.", NumLit "3.")
> ,("3.3", NumLit "3.3") > ,("3.3", NumLit "3.3")
@ -44,27 +44,27 @@ Tests for parsing scalar expressions
> ] > ]
> identifiers :: TestItem > identifiers :: TestItem
> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr) > identifiers = Group "identifiers" $ map (uncurry TestValueExpr)
> [("iden1", Iden "iden1") > [("iden1", Iden "iden1")
> --,("t.a", Iden2 "t" "a") > --,("t.a", Iden2 "t" "a")
> ,("\"quoted identifier\"", Iden $ QName "quoted identifier") > ,("\"quoted identifier\"", Iden $ QName "quoted identifier")
> ] > ]
> star :: TestItem > star :: TestItem
> star = Group "star" $ map (uncurry TestScalarExpr) > star = Group "star" $ map (uncurry TestValueExpr)
> [("*", Star) > [("*", Star)
> --,("t.*", Star2 "t") > --,("t.*", Star2 "t")
> --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"]) > --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
> ] > ]
> parameter :: TestItem > parameter :: TestItem
> parameter = Group "parameter" $ map (uncurry TestScalarExpr) > parameter = Group "parameter" $ map (uncurry TestValueExpr)
> [("?", Parameter) > [("?", Parameter)
> ] > ]
> dots :: TestItem > dots :: TestItem
> dots = Group "dot" $ map (uncurry TestScalarExpr) > dots = Group "dot" $ map (uncurry TestValueExpr)
> [("t.a", BinOp (Iden "t") "." (Iden "a")) > [("t.a", BinOp (Iden "t") "." (Iden "a"))
> ,("t.*", BinOp (Iden "t") "." Star) > ,("t.*", BinOp (Iden "t") "." Star)
> ,("a.b.c", BinOp (BinOp (Iden "a") "." (Iden "b")) "." (Iden "c")) > ,("a.b.c", BinOp (BinOp (Iden "a") "." (Iden "b")) "." (Iden "c"))
@ -72,14 +72,14 @@ Tests for parsing scalar expressions
> ] > ]
> app :: TestItem > app :: TestItem
> app = Group "app" $ map (uncurry TestScalarExpr) > app = Group "app" $ map (uncurry TestValueExpr)
> [("f()", App "f" []) > [("f()", App "f" [])
> ,("f(a)", App "f" [Iden "a"]) > ,("f(a)", App "f" [Iden "a"])
> ,("f(a,b)", App "f" [Iden "a", Iden "b"]) > ,("f(a,b)", App "f" [Iden "a", Iden "b"])
> ] > ]
> caseexp :: TestItem > caseexp :: TestItem
> caseexp = Group "caseexp" $ map (uncurry TestScalarExpr) > caseexp = Group "caseexp" $ map (uncurry TestValueExpr)
> [("case a when 1 then 2 end" > [("case a when 1 then 2 end"
> ,Case (Just $ Iden "a") [([NumLit "1"] > ,Case (Just $ Iden "a") [([NumLit "1"]
> ,NumLit "2")] Nothing) > ,NumLit "2")] Nothing)
@ -115,7 +115,7 @@ Tests for parsing scalar expressions
> ,miscOps] > ,miscOps]
> binaryOperators :: TestItem > binaryOperators :: TestItem
> binaryOperators = Group "binaryOperators" $ map (uncurry TestScalarExpr) > binaryOperators = Group "binaryOperators" $ map (uncurry TestValueExpr)
> [("a + b", BinOp (Iden "a") "+" (Iden "b")) > [("a + b", BinOp (Iden "a") "+" (Iden "b"))
> -- sanity check fixities > -- sanity check fixities
> -- todo: add more fixity checking > -- todo: add more fixity checking
@ -130,7 +130,7 @@ Tests for parsing scalar expressions
> ] > ]
> unaryOperators :: TestItem > unaryOperators :: TestItem
> unaryOperators = Group "unaryOperators" $ map (uncurry TestScalarExpr) > unaryOperators = Group "unaryOperators" $ map (uncurry TestValueExpr)
> [("not a", PrefixOp "not" $ Iden "a") > [("not a", PrefixOp "not" $ Iden "a")
> ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a") > ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a")
> ,("+a", PrefixOp "+" $ Iden "a") > ,("+a", PrefixOp "+" $ Iden "a")
@ -139,7 +139,7 @@ Tests for parsing scalar expressions
> casts :: TestItem > casts :: TestItem
> casts = Group "operators" $ map (uncurry TestScalarExpr) > casts = Group "operators" $ map (uncurry TestValueExpr)
> [("cast('1' as int)" > [("cast('1' as int)"
> ,Cast (StringLit "1") $ TypeName "int") > ,Cast (StringLit "1") $ TypeName "int")
@ -161,7 +161,7 @@ Tests for parsing scalar expressions
> ] > ]
> subqueries :: TestItem > subqueries :: TestItem
> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr) > subqueries = Group "unaryOperators" $ map (uncurry TestValueExpr)
> [("exists (select a from t)", SubQueryExpr SqExists ms) > [("exists (select a from t)", SubQueryExpr SqExists ms)
> ,("(select a from t)", SubQueryExpr SqSq ms) > ,("(select a from t)", SubQueryExpr SqSq ms)
@ -187,7 +187,7 @@ Tests for parsing scalar expressions
> } > }
> miscOps :: TestItem > miscOps :: TestItem
> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr) > miscOps = Group "unaryOperators" $ map (uncurry TestValueExpr)
> [("a in (1,2,3)" > [("a in (1,2,3)"
> ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"]) > ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"])
@ -324,7 +324,7 @@ target_string
> ] > ]
> aggregates :: TestItem > aggregates :: TestItem
> aggregates = Group "aggregates" $ map (uncurry TestScalarExpr) > aggregates = Group "aggregates" $ map (uncurry TestValueExpr)
> [("count(*)",App "count" [Star]) > [("count(*)",App "count" [Star])
> ,("sum(a order by a)" > ,("sum(a order by a)"
@ -339,7 +339,7 @@ target_string
> ] > ]
> windowFunctions :: TestItem > windowFunctions :: TestItem
> windowFunctions = Group "windowFunctions" $ map (uncurry TestScalarExpr) > windowFunctions = Group "windowFunctions" $ map (uncurry TestValueExpr)
> [("max(a) over ()", WindowApp "max" [Iden "a"] [] [] Nothing) > [("max(a) over ()", WindowApp "max" [Iden "a"] [] [] Nothing)
> ,("count(*) over ()", WindowApp "count" [Star] [] [] Nothing) > ,("count(*) over ()", WindowApp "count" [Star] [] [] Nothing)
@ -398,7 +398,7 @@ target_string
> ] > ]
> parens :: TestItem > parens :: TestItem
> parens = Group "parens" $ map (uncurry TestScalarExpr) > parens = Group "parens" $ map (uncurry TestValueExpr)
> [("(a)", Parens (Iden "a")) > [("(a)", Parens (Iden "a"))
> ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b"))) > ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b")))
> ] > ]