add support for union,intersect,except

Language/SQL/SimpleSQL/Parser.lhs

@@ -130,7 +130,8 @@ digitse[+-]digits
 > blacklist = ["as", "from", "where", "having", "group", "order"
 >             ,"inner", "left", "right", "full", "natural", "join"
 >             ,"on", "using", "when", "then", "case", "end", "order"
->             ,"limit", "offset", "in"]
+>             ,"limit", "offset", "in"
+>             ,"except", "intersect", "union"]
 
 TODO: talk about what must be in the blacklist, and what doesn't need
 to be.
@@ -512,17 +513,28 @@ attempt to fix the precedence and associativity. Doesn't work
 
 > queryExpr :: P QueryExpr
 > queryExpr =
->     try (keyword_ "select") >>
+>     (try (keyword_ "select") >>
->     Select
+>      Select
->     <$> (fromMaybe All <$> duplicates)
+>      <$> (fromMaybe All <$> duplicates)
->     <*> selectList
+>      <*> selectList
->     <*> from
+>      <*> from
->     <*> swhere
+>      <*> swhere
->     <*> sgroupBy
+>      <*> sgroupBy
->     <*> having
+>      <*> having
->     <*> option [] orderBy
+>      <*> option [] orderBy
->     <*> limit
+>      <*> limit
->     <*> offset
+>      <*> offset)
+>     >>= queryExprSuffix
+
+> queryExprSuffix :: QueryExpr -> P QueryExpr
+> queryExprSuffix qe =
+>     choice [CombineQueryExpr qe
+>             <$> try (choice
+>                      [Union <$ keyword "union"
+>                      ,Intersect <$ keyword "intersect"
+>                      ,Except <$ keyword "except"])
+>             <*> queryExpr
+>            ,return qe]
 
 ------------------------------------------------
 

Language/SQL/SimpleSQL/Pretty.lhs

@@ -119,6 +119,13 @@ back into SQL source text. It attempts to format the output nicely.
 >       ,maybeScalarExpr "limit" lm
 >       ,maybeScalarExpr "offset" off
 >       ]
+> queryExpr (CombineQueryExpr q1 ct q2) =
+>   sep [queryExpr q1
+>       ,text $ case ct of
+>            Union -> "union"
+>            Intersect -> "intersect"
+>            Except -> "except"
+>       ,queryExpr q2]
 
 > selectList :: [(Maybe String, ScalarExpr)] -> Doc
 > selectList is = commaSep $ map si is

Language/SQL/SimpleSQL/Syntax.lhs

@@ -8,6 +8,7 @@
 >     ,makeSelect
 >     ,Duplicates(..)
 >     ,Direction(..)
+>     ,CombineOp(..)
 >     ,TableRef(..)
 >     ,JoinType(..)
 >     ,JoinCondition(..)
@@ -64,10 +65,17 @@
 >       ,qeOrderBy :: [(ScalarExpr,Direction)]
 >       ,qeLimit :: Maybe ScalarExpr
 >       ,qeOffset :: Maybe ScalarExpr
->       } deriving (Eq,Show)
+>       }
+>     | CombineQueryExpr
+>       {qe1 :: QueryExpr
+>       ,qeCombOp :: CombineOp
+>       ,qe2 :: QueryExpr
+>       }
+>       deriving (Eq,Show)
 
 > data Duplicates = Distinct | All deriving (Eq,Show)
 > data Direction = Asc | Desc deriving (Eq,Show)
+> data CombineOp = Union | Except | Intersect deriving (Eq,Show)
 
 > makeSelect :: QueryExpr
 > makeSelect = Select {qeDuplicates = All

Tests.lhs

@@ -364,13 +364,20 @@
 
 > combos :: TestItem
 > combos = Group "combos" $ map (uncurry TestQueryExpr)
->     [{-("select a from t union select b from u"
+>     [("select a from t union select b from u"
->      ,makeSelect)
+>      ,CombineQueryExpr ms1 Union ms2)
 >     ,("select a from t intersect select b from u"
->      ,makeSelect)
+>      ,CombineQueryExpr ms1 Intersect ms2)
 >     ,("select a from t except select b from u"
->      ,makeSelect)-}
+>      ,CombineQueryExpr ms1 Except ms2)
 >     ]
+>   where
+>     ms1 = makeSelect
+>           {qeSelectList = [(Nothing,Iden "a")]
+>           ,qeFrom = [SimpleTableRef "t"]}
+>     ms2 = makeSelect
+>           {qeSelectList = [(Nothing,Iden "b")]
+>           ,qeFrom = [SimpleTableRef "u"]}
 
 > fullQueries :: TestItem
 > fullQueries = Group "queries" $ map (uncurry TestQueryExpr)