From 3f08adb4c5fc2d0414ec114f178ce7cb1a05ce58 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sat, 14 Dec 2013 11:59:29 +0200
Subject: [PATCH] work on the semicolon handling

---
 Language/SQL/SimpleSQL/Parser.lhs | 10 ++++------
 Language/SQL/SimpleSQL/Pretty.lhs |  3 +++
 Tests.lhs                         | 15 +++++++++++++++
 3 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 9579006..a4fc568 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -612,7 +612,7 @@ wrapper for query expr which ignores optional trailing semicolon.
 
 > topLevelQueryExpr :: P QueryExpr
 > topLevelQueryExpr =
->     queryExpr <* (choice [try $ symbol_ ";", return()])
+>      queryExpr >>= optionSuffix ((symbol ";" *>) . return)
 
 wrapper to parse a series of query exprs from a single source. They
 must be separated by semicolon, but for the last expression, the
@@ -620,11 +620,9 @@ trailing semicolon is optional.
 
 > queryExprs :: P [QueryExpr]
 > queryExprs = do
->     qe <- queryExpr
->     choice [[qe] <$ eof
->            ,symbol_ ";" *>
->             choice [[qe] <$ eof
->                    ,(:) qe <$> queryExprs]]
+>     ((:[]) <$> queryExpr)
+>     >>= optionSuffix ((symbol ";" *>) . return)
+>     >>= optionSuffix (\p -> (p++) <$> queryExprs)
 
 ------------------------------------------------
 
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index ffb4b9e..8cc9e9e 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -5,6 +5,7 @@ back into SQL source text. It attempts to format the output nicely.
 > module Language.SQL.SimpleSQL.Pretty
 >     (prettyQueryExpr
 >     ,prettyScalarExpr
+>     ,prettyQueryExprs
 >     ) where
 
 > import Language.SQL.SimpleSQL.Syntax
@@ -17,6 +18,8 @@ back into SQL source text. It attempts to format the output nicely.
 > prettyScalarExpr :: ScalarExpr -> String
 > prettyScalarExpr = render . scalarExpr
 
+> prettyQueryExprs :: [QueryExpr] -> String
+> prettyQueryExprs = render . vcat . map ((<> text ";") . queryExpr)
 
 = scalar expressions
 
diff --git a/Tests.lhs b/Tests.lhs
index 7913680..1acc2b9 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -11,6 +11,7 @@
 > data TestItem = Group String [TestItem]
 >               | TestScalarExpr String ScalarExpr
 >               | TestQueryExpr String QueryExpr
+>               | TestQueryExprs String [QueryExpr]
 >               | ParseQueryExpr String
 >                 deriving (Eq,Show)
 
@@ -440,6 +441,17 @@
 >      )
 >     ]
 
+> queryExprsParserTests :: TestItem
+> queryExprsParserTests = Group "query exprs" $ map (uncurry TestQueryExprs)
+>     [("select 1",[ms])
+>     ,("select 1;",[ms])
+>     ,("select 1;select 1",[ms,ms])
+>     ,("select 1;select 1;",[ms,ms])
+>     ,(" select 1;select 1; ",[ms,ms])
+>     ]
+>   where
+>     ms = makeSelect {qeSelectList = [(Nothing,NumLit "1")]}
+
 > tpchTests :: TestItem
 > tpchTests =
 >     Group "parse tpch"
@@ -450,6 +462,7 @@
 >     Group "parserTest"
 >     [scalarExprParserTests
 >     ,queryExprParserTests
+>     ,queryExprsParserTests
 >     ,tpchTests
 >     ]
 
@@ -464,6 +477,8 @@
 >     toTest parseScalarExpr prettyScalarExpr str expected
 > itemToTest (TestQueryExpr str expected) =
 >     toTest parseQueryExpr prettyQueryExpr str expected
+> itemToTest (TestQueryExprs str expected) =
+>     toTest parseQueryExprs prettyQueryExprs str expected
 > itemToTest (ParseQueryExpr str) =
 >     toPTest parseQueryExpr prettyQueryExpr str