From 386d835cf8bdc251ed854a865af3d48b47c04b7b Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 21:00:06 +0200
Subject: [PATCH] add support for in list, and fix code for in query expr
---
Language/SQL/SimpleSQL/Parser.lhs | 20 +++++++++++---
Language/SQL/SimpleSQL/Pretty.lhs | 10 ++++++-
Language/SQL/SimpleSQL/Syntax.lhs | 8 +++++-
Tests.lhs | 45 ++++++++++++++++---------------
4 files changed, 57 insertions(+), 26 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 9ff8f78..65cb1cb 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -132,7 +132,7 @@ digitse[+-]digits
> blacklist = ["as", "from", "where", "having", "group", "order"
> ,"inner", "left", "right", "full", "natural", "join"
> ,"on", "using", "when", "then", "case", "end", "order"
-> ,"limit", "offset"]
+> ,"limit", "offset", "in"]
TODO: talk about what must be in the blacklist, and what doesn't need
to be.
@@ -174,6 +174,18 @@ to be.
> prefixCast = try (CastOp <$> typeName
> <*> stringLiteral)
+> inSuffix :: ScalarExpr -> P ScalarExpr
+> inSuffix e =
+> In
+> <$> inty
+> <*> return e
+> <*> parens (choice
+> [InQueryExpr <$> queryExpr
+> ,InList <$> commaSep1 scalarExpr])
+> where
+> inty = try $ choice [True <$ keyword_ "in"
+> ,False <$ keyword_ "not" <* keyword_ "in"]
+
> subquery :: P ScalarExpr
> subquery =
> choice
@@ -182,7 +194,6 @@ to be.
> where
> sqkw = try $ choice
> [SqExists <$ keyword_ "exists"
-> ,SqIn <$ keyword_ "in"
> ,SqAll <$ try (keyword_ "all")
> ,SqAny <$ keyword_ "any"
> ,SqSome <$ keyword_ "some"]
@@ -232,7 +243,10 @@ to be.
> ,identifier
> ,sparens]
> trysuffix e = try (suffix e) <|> return e
-> suffix e0 = (makeOp e0 <$> opSymbol <*> factor) >>= trysuffix
+> suffix e0 = choice
+> [makeOp e0 <$> opSymbol <*> factor
+> ,inSuffix e0
+> ] >>= trysuffix
> opSymbol = choice (map (try . symbol) binOpSymbolNames
> ++ map (try . keyword) binOpKeywordNames)
> makeOp e0 op e1 = Op op [e0,e1]
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index fe58a38..c3adfcf 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -59,12 +59,20 @@ back into SQL source text. It attempts to format the output nicely.
> (case ty of
> SqSq -> empty
> SqExists -> text "exists"
-> SqIn -> text "in"
> SqAll -> text "all"
> SqSome -> text "some"
> SqAny -> text "any"
> ) <+> parens (queryExpr qe)
+> scalarExpr (In b se x) =
+> sep [scalarExpr se
+> ,if b then empty else text "not"
+> ,text "in"
+> ,parens (nest 4 $
+> case x of
+> InList es -> commaSep $ map scalarExpr es
+> InQueryExpr qe -> queryExpr qe)]
+
= query expressions
> queryExpr :: QueryExpr -> Doc
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 8bda907..db259e1 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -3,6 +3,7 @@
> (ScalarExpr(..)
> ,TypeName(..)
> ,SubQueryExprType(..)
+> ,InThing(..)
> ,QueryExpr(..)
> ,makeSelect
> ,Duplicates(..)
@@ -28,11 +29,16 @@
> | Cast ScalarExpr TypeName
> | CastOp TypeName String
> | SubQueryExpr SubQueryExprType QueryExpr
+> | In Bool -- true if in, false if not in
+> ScalarExpr InThing
> deriving (Eq,Show)
> data TypeName = TypeName String deriving (Eq,Show)
+> data InThing = InList [ScalarExpr]
+> | InQueryExpr QueryExpr
+> deriving (Eq,Show)
-> data SubQueryExprType = SqExists | SqIn | SqSq | SqAll | SqSome | SqAny
+> data SubQueryExprType = SqExists | SqSq | SqAll | SqSome | SqAny
> deriving (Eq,Show)
> data QueryExpr
diff --git a/Tests.lhs b/Tests.lhs
index bec95ec..4fee678 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -126,8 +126,10 @@
> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr)
> [("exists (select a from t)", SubQueryExpr SqExists ms)
> ,("(select a from t)", SubQueryExpr SqSq ms)
-> ,("in (select a from t)", SubQueryExpr SqIn ms)
-> ,("not in (select a from t)", Op "not" [SubQueryExpr SqIn ms])
+> ,("a in (select a from t)"
+> ,In True (Iden "a") (InQueryExpr ms))
+> ,("a not in (select a from t)"
+> ,In False (Iden "a") (InQueryExpr ms))
> ,("a > all (select a from t)"
> ,Op ">" [Iden "a", SubQueryExpr SqAll ms])
> ,("a = some (select a from t)"
@@ -143,25 +145,26 @@
> miscOps :: TestItem
> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr)
-> [{-("a in (1,2,3)", Op "not" [Iden "a"])
-> ,("a between b and c", Op "not" [])
-> ,("a not between b and c", Op "not" [])
-> ,("a is null", Op "not" [])
-> ,("a is not null", Op "not" [])
-> ,("a is distinct from b", Op "not" [])
-> ,("a is not distinct from b", Op "not" [])
-> ,("a is true", Op "not" [])
-> ,("a s not true", Op "not" [])
-> ,("a is false", Op "not" [])
-> ,("a is not false", Op "not" [])
-> ,("a is unknown", Op "not" [])
-> ,("a is not unknown", Op "not" [])
-> ,("a like b", Op "not" [])
-> ,("a not like b", Op "not" [])
-> ,("a is similar to b", Op "not" [])
-> ,("a is not similar to b", Op "not" [])
-> ,("a overlaps b", Op "not" [])
-> ,("extract(day from t)", Op "not" [])-}
+> [("a in (1,2,3)"
+> ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"])
+> --,("a between b and c", Op "not" [])
+> --,("a not between b and c", Op "not" [])
+> --,("a is null", Op "not" [])
+> --,("a is not null", Op "not" [])
+> --,("a is distinct from b", Op "not" [])
+> --,("a is not distinct from b", Op "not" [])
+> --,("a is true", Op "not" [])
+> --,("a s not true", Op "not" [])
+> --,("a is false", Op "not" [])
+> --,("a is not false", Op "not" [])
+> --,("a is unknown", Op "not" [])
+> --,("a is not unknown", Op "not" [])
+> --,("a like b", Op "not" [])
+> --,("a not like b", Op "not" [])
+> --,("a is similar to b", Op "not" [])
+> --,("a is not similar to b", Op "not" [])
+> --,("a overlaps b", Op "not" [])
+> --,("extract(day from t)", Op "not" [])
> ]
> aggregates :: TestItem