add support for union all and union corresponding and for intersect and except

Language/SQL/SimpleSQL/Parser.lhs

@@ -530,9 +530,13 @@ attempt to fix the precedence and associativity. Doesn't work
 > queryExprSuffix qe =
 >     choice [CombineQueryExpr qe
 >             <$> try (choice
->                      [Union <$ keyword "union"
+>                      [Union <$ keyword_ "union"
->                      ,Intersect <$ keyword "intersect"
+>                      ,Intersect <$ keyword_ "intersect"
->                      ,Except <$ keyword "except"])
+>                      ,Except <$ keyword_ "except"])
+>             <*> (fromMaybe All <$> duplicates)
+>             <*> (option Respectively
+>                  $ try (Corresponding
+>                         <$ keyword_ "corresponding"))
 >             <*> queryExpr
 >            ,return qe]
 

Language/SQL/SimpleSQL/Pretty.lhs

@@ -119,12 +119,18 @@ back into SQL source text. It attempts to format the output nicely.
 >       ,maybeScalarExpr "limit" lm
 >       ,maybeScalarExpr "offset" off
 >       ]
-> queryExpr (CombineQueryExpr q1 ct q2) =
+> queryExpr (CombineQueryExpr q1 ct d c q2) =
 >   sep [queryExpr q1
->       ,text $ case ct of
+>       ,text (case ct of
->            Union -> "union"
+>                 Union -> "union"
->            Intersect -> "intersect"
+>                 Intersect -> "intersect"
->            Except -> "except"
+>                 Except -> "except")
+>        <+> case d of
+>                All -> empty
+>                Distinct -> text "distinct"
+>        <+> case c of
+>                Corresponding -> text "corresponding"
+>                Respectively -> empty
 >       ,queryExpr q2]
 
 > selectList :: [(Maybe String, ScalarExpr)] -> Doc

Language/SQL/SimpleSQL/Syntax.lhs

@@ -9,6 +9,7 @@
 >     ,Duplicates(..)
 >     ,Direction(..)
 >     ,CombineOp(..)
+>     ,Corresponding(..)
 >     ,TableRef(..)
 >     ,JoinType(..)
 >     ,JoinCondition(..)
@@ -69,6 +70,8 @@
 >     | CombineQueryExpr
 >       {qe1 :: QueryExpr
 >       ,qeCombOp :: CombineOp
+>       ,qeDuplicates :: Duplicates
+>       ,qeCorresponding :: Corresponding
 >       ,qe2 :: QueryExpr
 >       }
 >       deriving (Eq,Show)
@@ -76,6 +79,7 @@
 > data Duplicates = Distinct | All deriving (Eq,Show)
 > data Direction = Asc | Desc deriving (Eq,Show)
 > data CombineOp = Union | Except | Intersect deriving (Eq,Show)
+> data Corresponding = Corresponding | Respectively deriving (Eq,Show)
 
 > makeSelect :: QueryExpr
 > makeSelect = Select {qeDuplicates = All

Tests.lhs

@@ -365,11 +365,14 @@
 > combos :: TestItem
 > combos = Group "combos" $ map (uncurry TestQueryExpr)
 >     [("select a from t union select b from u"
->      ,CombineQueryExpr ms1 Union ms2)
+>      ,CombineQueryExpr ms1 Union All Respectively ms2)
 >     ,("select a from t intersect select b from u"
->      ,CombineQueryExpr ms1 Intersect ms2)
+>      ,CombineQueryExpr ms1 Intersect All Respectively ms2)
->     ,("select a from t except select b from u"
+>     ,("select a from t except all select b from u"
->      ,CombineQueryExpr ms1 Except ms2)
+>      ,CombineQueryExpr ms1 Except All Respectively ms2)
+>     ,("select a from t union distinct corresponding \
+>       \select b from u"
+>      ,CombineQueryExpr ms1 Union Distinct Corresponding ms2)
 >     ]
 >   where
 >     ms1 = makeSelect