diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 3321087..50c5c1f 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/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") >> -> Select -> <$> (fromMaybe All <$> duplicates) -> <*> selectList -> <*> from -> <*> swhere -> <*> sgroupBy -> <*> having -> <*> option [] orderBy -> <*> limit -> <*> offset +> (try (keyword_ "select") >> +> Select +> <$> (fromMaybe All <$> duplicates) +> <*> selectList +> <*> from +> <*> swhere +> <*> sgroupBy +> <*> having +> <*> option [] orderBy +> <*> limit +> <*> 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] ------------------------------------------------ diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 8199e54..11a3f81 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/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 diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index c0cc67c..9da3567 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/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 diff --git a/Tests.lhs b/Tests.lhs index 0a78233..85d6796 100644 --- a/Tests.lhs +++ b/Tests.lhs @@ -364,13 +364,20 @@ > combos :: TestItem > combos = Group "combos" $ map (uncurry TestQueryExpr) -> [{-("select a from t union select b from u" -> ,makeSelect) +> [("select a from t union select b from u" +> ,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)