diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 50c5c1f..867dd6f 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/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" -> ,Intersect <$ keyword "intersect" -> ,Except <$ keyword "except"]) +> [Union <$ keyword_ "union" +> ,Intersect <$ keyword_ "intersect" +> ,Except <$ keyword_ "except"]) +> <*> (fromMaybe All <$> duplicates) +> <*> (option Respectively +> $ try (Corresponding +> <$ keyword_ "corresponding")) > <*> queryExpr > ,return qe] diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 11a3f81..38412ab 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/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 -> Union -> "union" -> Intersect -> "intersect" -> Except -> "except" +> ,text (case ct of +> Union -> "union" +> Intersect -> "intersect" +> 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 diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 9da3567..f86d232 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/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 diff --git a/Tests.lhs b/Tests.lhs index 85d6796..04059d2 100644 --- a/Tests.lhs +++ b/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) -> ,("select a from t except select b from u" -> ,CombineQueryExpr ms1 Except ms2) +> ,CombineQueryExpr ms1 Intersect All Respectively ms2) +> ,("select a from t except all select b from u" +> ,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