From 00269617b3a855dd3eeadc743d0fc53ddeb4a932 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 20:43:28 +0200
Subject: [PATCH] add support for subqueries in scalar expressions
---
Language/SQL/SimpleSQL/Parser.lhs | 29 +++++++++++++++++++++++------
Language/SQL/SimpleSQL/Pretty.lhs | 10 ++++++++++
Language/SQL/SimpleSQL/Syntax.lhs | 5 +++++
Tests.lhs | 22 +++++++++++++++-------
4 files changed, 53 insertions(+), 13 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 81912fd..9ff8f78 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -130,9 +130,9 @@ digitse[+-]digits
> letterDigitOrUnderscore = char '_' <|> alphaNum
> blacklist :: [String]
> blacklist = ["as", "from", "where", "having", "group", "order"
-> ,"inner", "left", "right", "full", "natural", "join"
-> ,"on", "using", "when", "then", "case", "end", "order"
-> ,"limit", "offset"]
+> ,"inner", "left", "right", "full", "natural", "join"
+> ,"on", "using", "when", "then", "case", "end", "order"
+> ,"limit", "offset"]
TODO: talk about what must be in the blacklist, and what doesn't need
to be.
@@ -174,6 +174,19 @@ to be.
> prefixCast = try (CastOp <$> typeName
> <*> stringLiteral)
+> subquery :: P ScalarExpr
+> subquery =
+> choice
+> [try $ SubQueryExpr SqSq <$> parens queryExpr
+> ,SubQueryExpr <$> try sqkw <*> parens queryExpr]
+> where
+> sqkw = try $ choice
+> [SqExists <$ keyword_ "exists"
+> ,SqIn <$ keyword_ "in"
+> ,SqAll <$ try (keyword_ "all")
+> ,SqAny <$ keyword_ "any"
+> ,SqSome <$ keyword_ "some"]
+
> typeName :: P TypeName
> typeName = choice
> [TypeName "double precision"
@@ -212,6 +225,7 @@ to be.
> factor = choice [literal
> ,scase
> ,cast
+> ,subquery
> ,unaryOp
> ,try app
> ,try dottedIden
@@ -226,6 +240,8 @@ to be.
> sparens :: P ScalarExpr
> sparens = Parens <$> parens scalarExpr'
+attempt to fix the precedence and associativity. Doesn't work
+
> toHaskell :: ScalarExpr -> HSE.Exp
> toHaskell e = case e of
> Iden i -> HSE.Var $ HSE.UnQual $ HSE.Ident i
@@ -248,6 +264,7 @@ to be.
> (HSE.List [ltoh $ maybeToList v
> ,HSE.List $ map (ltoh . (\(a,b) -> [a,b])) ts
> ,ltoh $ maybeToList el])
+> _ -> error "please fix me 1"
> where
> ltoh = HSE.List . map toHaskell
@@ -294,14 +311,14 @@ to be.
> ++ HSE.infixl_ 1 ["and"]
> ++ HSE.infixl_ 0 ["or"]
-> fixFixity :: ScalarExpr -> ScalarExpr
-> fixFixity se = runIdentity $
+> _fixFixity :: ScalarExpr -> ScalarExpr
+> _fixFixity se = runIdentity $
> toSql <$> HSE.applyFixities sqlFixities (toHaskell se)
> scalarExpr :: P ScalarExpr
> scalarExpr =
> choice [try star
-> ,fixFixity <$> scalarExpr']
+> ,{-fixFixity <$>-} scalarExpr']
-------------------------------------------------
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 67e8cc7..fe58a38 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -55,6 +55,16 @@ back into SQL source text. It attempts to format the output nicely.
> scalarExpr (CastOp (TypeName tn) s) =
> text tn <+> quotes (text s)
+> scalarExpr (SubQueryExpr ty qe) =
+> (case ty of
+> SqSq -> empty
+> SqExists -> text "exists"
+> SqIn -> text "in"
+> SqAll -> text "all"
+> SqSome -> text "some"
+> SqAny -> text "any"
+> ) <+> parens (queryExpr qe)
+
= query expressions
> queryExpr :: QueryExpr -> Doc
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index c100c88..8bda907 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -2,6 +2,7 @@
> module Language.SQL.SimpleSQL.Syntax
> (ScalarExpr(..)
> ,TypeName(..)
+> ,SubQueryExprType(..)
> ,QueryExpr(..)
> ,makeSelect
> ,Duplicates(..)
@@ -26,10 +27,14 @@
> | Parens ScalarExpr
> | Cast ScalarExpr TypeName
> | CastOp TypeName String
+> | SubQueryExpr SubQueryExprType QueryExpr
> deriving (Eq,Show)
> data TypeName = TypeName String deriving (Eq,Show)
+> data SubQueryExprType = SqExists | SqIn | SqSq | SqAll | SqSome | SqAny
+> deriving (Eq,Show)
+
> data QueryExpr
> = Select
> {qeDuplicates :: Duplicates
diff --git a/Tests.lhs b/Tests.lhs
index 9a1c5c1..bec95ec 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -124,14 +124,22 @@
> subqueries :: TestItem
> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr)
-> [{-("exists (select * from t)", Op "not" [Iden "a"])
-> ,("(select a from t)", Op "not" [Op "not" [Iden "a"]])
-> ,("in (select a from t)", Op "+" [Iden "a"])
-> ,("not in (select a from t)", Op "+" [Iden "a"])
-> ,("a > ALL (select a from t)", Op "-" [Iden "a"])
-> ,("a > SOME (select a from t)", Op "-" [Iden "a"])
-> ,("a > ANY (select a from t)", Op "-" [Iden "a"])-}
+> [("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 > all (select a from t)"
+> ,Op ">" [Iden "a", SubQueryExpr SqAll ms])
+> ,("a = some (select a from t)"
+> ,Op "=" [Iden "a", SubQueryExpr SqSome ms])
+> ,("a <= any (select a from t)"
+> ,Op "<=" [Iden "a", SubQueryExpr SqAny ms])
> ]
+> where
+> ms = makeSelect
+> {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [SimpleTableRef "t"]
+> }
> miscOps :: TestItem
> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr)