From 8b1fa81de73eebe2527fff655368f36d266e8c71 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Tue, 15 Apr 2014 13:47:34 +0300
Subject: [PATCH] fix bug in parsing default as all instead of distinct for set
 operations

---
 Language/SQL/SimpleSQL/Parser.lhs             |  2 +-
 TODO                                          | 23 +++++++++++++++----
 .../SQL/SimpleSQL/QueryExprComponents.lhs     |  8 +++----
 tools/Language/SQL/SimpleSQL/Tests.lhs        |  8 +++++--
 4 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 06f6bef..83540ae 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -747,7 +747,7 @@ and union, etc..
 >               [Union <$ keyword_ "union"
 >               ,Intersect <$ keyword_ "intersect"
 >               ,Except <$ keyword_ "except"])
->      <*> (fromMaybe All <$> duplicates)
+>      <*> (fromMaybe Distinct <$> duplicates)
 >      <*> option Respectively
 >                 (try (Corresponding <$ keyword_ "corresponding"))
 >      <*> queryExpr)
diff --git a/TODO b/TODO
index 60a25a1..ac5130f 100644
--- a/TODO
+++ b/TODO
@@ -1,3 +1,10 @@
+synchronize parsing and syntax design with tutorial parser?
+
+error handling work: <?> + left factor
+
+create list of features to add, maybe try to do up to sql 99 for the
+   next release?
+
 = next release
 
 try and use the proper css theme
@@ -171,7 +178,15 @@ maybe later: other dml
   copy, execute?, explain?, begin/end/rollback?
 
 big feature summary:
-1. dialects
-2. position annotation
-3. dml
-4. quasiquotes
+all ansi sql queries
+error messages, left factor
+position annotation
+type checker/ etc.
+lexer
+dialects
+dml, ddl, procedural sql
+quasi quotes
+typesafe sql dbms wrapper support for haskell
+extensibility
+better expression tree parsing
+performance analysis
\ No newline at end of file
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
index dd4333b..5c756f4 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -144,10 +144,10 @@ These are a few misc tests which don't fit anywhere else.
 > combos :: TestItem
 > combos = Group "combos" $ map (uncurry TestQueryExpr)
 >     [("select a from t union select b from u"
->      ,CombineQueryExpr ms1 Union All Respectively ms2)
+>      ,CombineQueryExpr ms1 Union Distinct Respectively ms2)
 
 >     ,("select a from t intersect select b from u"
->      ,CombineQueryExpr ms1 Intersect All Respectively ms2)
+>      ,CombineQueryExpr ms1 Intersect Distinct Respectively ms2)
 
 >     ,("select a from t except all select b from u"
 >      ,CombineQueryExpr ms1 Except All Respectively ms2)
@@ -160,8 +160,8 @@ These are a few misc tests which don't fit anywhere else.
 >      -- TODO: union should be left associative. I think the others also
 >      -- so this needs to be fixed (new optionSuffix variation which
 >      -- handles this)
->      ,CombineQueryExpr ms1 Union All Respectively
->        (CombineQueryExpr ms1 Union All Respectively ms1))
+>      ,CombineQueryExpr ms1 Union Distinct Respectively
+>        (CombineQueryExpr ms1 Union Distinct Respectively ms1))
 >     ]
 >   where
 >     ms1 = makeSelect
diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs
index 6bf41c3..87439f0 100644
--- a/tools/Language/SQL/SimpleSQL/Tests.lhs
+++ b/tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -79,9 +79,12 @@ order on the generated documentation.
 >                 let str' = pp got
 >                 let egot' = parser "" Nothing str'
 >                 case egot' of
->                     Left e' -> H.assertFailure $ "pp roundtrip "
+>                     Left e' -> H.assertFailure $ "pp roundtrip"
+>                                                  ++ "\n" ++ str'
 >                                                  ++ peFormattedError e'
->                     Right got' -> H.assertEqual "pp roundtrip" expected got'
+>                     Right got' -> H.assertEqual
+>                                   ("pp roundtrip" ++ "\n" ++ str')
+>                                    expected got'
 
 > toPTest :: (Eq a, Show a) =>
 >           (String -> Maybe (Int,Int) -> String -> Either ParseError a)
@@ -97,5 +100,6 @@ order on the generated documentation.
 >                 let egot' = parser "" Nothing str'
 >                 case egot' of
 >                     Left e' -> H.assertFailure $ "pp roundtrip "
+>                                                  ++ "\n" ++ str' ++ "\n"
 >                                                  ++ peFormattedError e'
 >                     Right _got' -> return ()