From 00269617b3a855dd3eeadc743d0fc53ddeb4a932 Mon Sep 17 00:00:00 2001 From: Jake Wheat 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)