add support for subqueries in scalar expressions

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']
 
 -------------------------------------------------
 

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

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

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)