switch from literate to regular haskell source

tools/Language/SQL/SimpleSQL/CreateIndex.hs

@@ -0,0 +1,17 @@
+
+module Language.SQL.SimpleSQL.CreateIndex where
+
+import Language.SQL.SimpleSQL.Syntax
+import Language.SQL.SimpleSQL.TestTypes
+
+createIndexTests :: TestItem
+createIndexTests = Group "create index tests"
+    [TestStatement ansi2011 "create index a on tbl(c1)"
+      $ CreateIndex False [nm "a"] [nm "tbl"] [nm "c1"]
+    ,TestStatement ansi2011 "create index a.b on sc.tbl (c1, c2)"
+      $ CreateIndex False [nm "a", nm "b"] [nm "sc", nm "tbl"] [nm "c1", nm "c2"]
+    ,TestStatement ansi2011 "create unique index a on tbl(c1)"
+      $ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]
+    ]
+  where
+    nm = Name Nothing

tools/Language/SQL/SimpleSQL/CreateIndex.lhs

@@ -1,17 +0,0 @@
-
-> module Language.SQL.SimpleSQL.CreateIndex where
->
-> import Language.SQL.SimpleSQL.Syntax
-> import Language.SQL.SimpleSQL.TestTypes
->
-> createIndexTests :: TestItem
-> createIndexTests = Group "create index tests"
->     [TestStatement ansi2011 "create index a on tbl(c1)"
->       $ CreateIndex False [nm "a"] [nm "tbl"] [nm "c1"]
->     ,TestStatement ansi2011 "create index a.b on sc.tbl (c1, c2)"
->       $ CreateIndex False [nm "a", nm "b"] [nm "sc", nm "tbl"] [nm "c1", nm "c2"]
->     ,TestStatement ansi2011 "create unique index a on tbl(c1)"
->       $ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]
->     ]
->   where
->     nm = Name Nothing

tools/Language/SQL/SimpleSQL/CustomDialect.hs

@@ -0,0 +1,27 @@
+
+module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+
+customDialectTests :: TestItem
+customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests
+    ++ map (uncurry ParseScalarExprFails) failTests )
+  where
+    failTests = [(ansi2011,"SELECT DATE('2000-01-01')")
+                ,(ansi2011,"SELECT DATE")
+                ,(dateApp,"SELECT DATE")
+                ,(dateIden,"SELECT DATE('2000-01-01')")
+                -- show this never being allowed as an alias
+                ,(ansi2011,"SELECT a date")
+                ,(dateApp,"SELECT a date")
+                ,(dateIden,"SELECT a date")
+                ]
+    passTests = [(ansi2011,"SELECT a b")
+                ,(noDateKeyword,"SELECT DATE('2000-01-01')")
+                ,(noDateKeyword,"SELECT DATE")
+                ,(dateApp,"SELECT DATE('2000-01-01')")
+                ,(dateIden,"SELECT DATE")
+                ]
+    noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}
+    dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}
+    dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}

tools/Language/SQL/SimpleSQL/CustomDialect.lhs

@@ -1,27 +0,0 @@
-
-> module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-
-> customDialectTests :: TestItem
-> customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests
->     ++ map (uncurry ParseScalarExprFails) failTests )
->   where
->     failTests = [(ansi2011,"SELECT DATE('2000-01-01')")
->                 ,(ansi2011,"SELECT DATE")
->                 ,(dateApp,"SELECT DATE")
->                 ,(dateIden,"SELECT DATE('2000-01-01')")
->                 -- show this never being allowed as an alias
->                 ,(ansi2011,"SELECT a date")
->                 ,(dateApp,"SELECT a date")
->                 ,(dateIden,"SELECT a date")
->                 ]
->     passTests = [(ansi2011,"SELECT a b")
->                 ,(noDateKeyword,"SELECT DATE('2000-01-01')")
->                 ,(noDateKeyword,"SELECT DATE")
->                 ,(dateApp,"SELECT DATE('2000-01-01')")
->                 ,(dateIden,"SELECT DATE")
->                 ]
->     noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}
->     dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}
->     dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}

tools/Language/SQL/SimpleSQL/EmptyStatement.hs

@@ -0,0 +1,20 @@
+module Language.SQL.SimpleSQL.EmptyStatement where
+
+import Language.SQL.SimpleSQL.Syntax
+import Language.SQL.SimpleSQL.TestTypes
+
+emptyStatementTests :: TestItem
+emptyStatementTests = Group "empty statement"
+  [ TestStatement ansi2011 ";" EmptyStatement
+  , TestStatements ansi2011 ";" [EmptyStatement]
+  , TestStatements ansi2011 ";;" [EmptyStatement, EmptyStatement]
+  , TestStatements ansi2011 ";;;" [EmptyStatement, EmptyStatement, EmptyStatement]
+  , TestStatement ansi2011 "/* comment */ ;" EmptyStatement
+  , TestStatements ansi2011 "" []
+  , TestStatements ansi2011 "/* comment */" []
+  , TestStatements ansi2011 "/* comment */ ;" [EmptyStatement]
+  , TestStatements ansi2011 "/* comment */ ; /* comment */ ;"
+      [EmptyStatement, EmptyStatement]
+  , TestStatements ansi2011 "/* comment */ ; /* comment */ ; /* comment */ ;"
+      [EmptyStatement, EmptyStatement, EmptyStatement]
+  ]

tools/Language/SQL/SimpleSQL/EmptyStatement.lhs

@@ -1,20 +0,0 @@
-> module Language.SQL.SimpleSQL.EmptyStatement where
->
-> import Language.SQL.SimpleSQL.Syntax
-> import Language.SQL.SimpleSQL.TestTypes
->
-> emptyStatementTests :: TestItem
-> emptyStatementTests = Group "empty statement"
->   [ TestStatement ansi2011 ";" EmptyStatement
->   , TestStatements ansi2011 ";" [EmptyStatement]
->   , TestStatements ansi2011 ";;" [EmptyStatement, EmptyStatement]
->   , TestStatements ansi2011 ";;;" [EmptyStatement, EmptyStatement, EmptyStatement]
->   , TestStatement ansi2011 "/* comment */ ;" EmptyStatement
->   , TestStatements ansi2011 "" []
->   , TestStatements ansi2011 "/* comment */" []
->   , TestStatements ansi2011 "/* comment */ ;" [EmptyStatement]
->   , TestStatements ansi2011 "/* comment */ ; /* comment */ ;"
->       [EmptyStatement, EmptyStatement]
->   , TestStatements ansi2011 "/* comment */ ; /* comment */ ; /* comment */ ;"
->       [EmptyStatement, EmptyStatement, EmptyStatement]
->   ]

tools/Language/SQL/SimpleSQL/ErrorMessages.hs

@@ -1,4 +1,5 @@
 
+{-
 Want to work on the error messages. Ultimately, parsec won't give the
 best error message for a parser combinator library in haskell. Should
 check out the alternatives such as polyparse and uu-parsing.
@@ -51,100 +52,105 @@ review the error messages.
 
 Then, create some query expressions to focus on the non value
 expression parts.
+-}
 
 
-> module Language.SQL.SimpleSQL.ErrorMessages where
+module Language.SQL.SimpleSQL.ErrorMessages where
 
-> {-import Language.SQL.SimpleSQL.Parser
-> import Data.List
-> import Text.Groom
+{-import Language.SQL.SimpleSQL.Parser
+import Data.List
+import Text.Groom
 
-> valueExpressions :: [String]
-> valueExpressions =
->     ["10.."
->     ,"..10"
->     ,"10e1e2"
->     ,"10e--3"
->     ,"1a"
->     ,"1%"
+valueExpressions :: [String]
+valueExpressions =
+    ["10.."
+    ,"..10"
+    ,"10e1e2"
+    ,"10e--3"
+    ,"1a"
+    ,"1%"
 
->     ,"'b'ad'"
->     ,"'bad"
->     ,"bad'"
+    ,"'b'ad'"
+    ,"'bad"
+    ,"bad'"
 
->     ,"interval '5' ay"
->     ,"interval '5' day (4.4)"
->     ,"interval '5' day (a)"
->     ,"intervala '5' day"
->     ,"interval 'x' day (3"
->     ,"interval 'x' day 3)"
+    ,"interval '5' ay"
+    ,"interval '5' day (4.4)"
+    ,"interval '5' day (a)"
+    ,"intervala '5' day"
+    ,"interval 'x' day (3"
+    ,"interval 'x' day 3)"
 
->     ,"1badiden"
->     ,"$"
->     ,"!"
->     ,"*.a"
+    ,"1badiden"
+    ,"$"
+    ,"!"
+    ,"*.a"
 
->     ,"??"
->     ,"3?"
->     ,"?a"
+    ,"??"
+    ,"3?"
+    ,"?a"
 
->     ,"row"
->     ,"row 1,2"
->     ,"row(1,2"
->     ,"row 1,2)"
->     ,"row(1 2)"
+    ,"row"
+    ,"row 1,2"
+    ,"row(1,2"
+    ,"row 1,2)"
+    ,"row(1 2)"
 
->     ,"f("
->     ,"f)"
+    ,"f("
+    ,"f)"
 
->     ,"f(a"
->     ,"f a)"
->     ,"f(a b)"
+    ,"f(a"
+    ,"f a)"
+    ,"f(a b)"
 
+{-
 TODO:
 case
 operators
+-}
 
->    ,"a + (b + c"
+   ,"a + (b + c"
 
+{-
 casts
 subqueries: + whole set of parentheses use
 in list
 'keyword' functions
 aggregates
 window functions
+-}
 
 
->    ]
+   ]
 
-> queryExpressions :: [String]
-> queryExpressions =
->     map sl1 valueExpressions
->     ++ map sl2 valueExpressions
->     ++ map sl3 valueExpressions
->     ++
->     ["select a from t inner jin u"]
->   where
->     sl1 x = "select " ++ x ++ " from t"
->     sl2 x = "select " ++ x ++ ", y from t"
->     sl3 x = "select " ++ x ++ " fom t"
+queryExpressions :: [String]
+queryExpressions =
+    map sl1 valueExpressions
+    ++ map sl2 valueExpressions
+    ++ map sl3 valueExpressions
+    ++
+    ["select a from t inner jin u"]
+  where
+    sl1 x = "select " ++ x ++ " from t"
+    sl2 x = "select " ++ x ++ ", y from t"
+    sl3 x = "select " ++ x ++ " fom t"
 
-> valExprs :: [String] -> [(String,String)]
-> valExprs = map parseOne
->   where
->     parseOne x = let p = parseValueExpr "" Nothing x
->                  in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)
+valExprs :: [String] -> [(String,String)]
+valExprs = map parseOne
+  where
+    parseOne x = let p = parseValueExpr "" Nothing x
+                 in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)
 
 
-> queryExprs :: [String] -> [(String,String)]
-> queryExprs = map parseOne
->   where
->     parseOne x = let p = parseQueryExpr "" Nothing x
->                  in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)
+queryExprs :: [String] -> [(String,String)]
+queryExprs = map parseOne
+  where
+    parseOne x = let p = parseQueryExpr "" Nothing x
+                 in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)
 
 
-> pExprs :: [String] -> [String] -> String
-> pExprs x y =
->     let l = valExprs x ++ queryExprs y
->     in intercalate "\n\n\n\n" $ map (\(a,b) -> a ++ "\n" ++ b) l
-> -}
+pExprs :: [String] -> [String] -> String
+pExprs x y =
+    let l = valExprs x ++ queryExprs y
+    in intercalate "\n\n\n\n" $ map (\(a,b) -> a ++ "\n" ++ b) l
+-}

tools/Language/SQL/SimpleSQL/FullQueries.hs

@@ -0,0 +1,39 @@
+
+-- Some tests for parsing full queries.
+
+module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+
+fullQueriesTests :: TestItem
+fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select count(*) from t"
+     ,makeSelect
+      {qeSelectList = [(App [Name Nothing "count"] [Star], Nothing)]
+      ,qeFrom = [TRSimple [Name Nothing "t"]]
+      }
+     )
+
+    ,("select a, sum(c+d) as s\n\
+      \  from t,u\n\
+      \  where a > 5\n\
+      \  group by a\n\
+      \  having count(1) > 5\n\
+      \  order by s"
+     ,makeSelect
+      {qeSelectList = [(Iden [Name Nothing "a"], Nothing)
+                      ,(App [Name Nothing "sum"]
+                        [BinOp (Iden [Name Nothing "c"])
+                               [Name Nothing "+"] (Iden [Name Nothing "d"])]
+                       ,Just $ Name Nothing "s")]
+      ,qeFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]
+      ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")
+      ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
+      ,qeHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"])
+                               [Name Nothing ">"] (NumLit "5")
+      ,qeOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault]
+      }
+     )
+    ]

tools/Language/SQL/SimpleSQL/FullQueries.lhs

@@ -1,39 +0,0 @@
-
-Some tests for parsing full queries.
-
-> module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-
-> fullQueriesTests :: TestItem
-> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select count(*) from t"
->      ,makeSelect
->       {qeSelectList = [(App [Name Nothing "count"] [Star], Nothing)]
->       ,qeFrom = [TRSimple [Name Nothing "t"]]
->       }
->      )
-
->     ,("select a, sum(c+d) as s\n\
->       \  from t,u\n\
->       \  where a > 5\n\
->       \  group by a\n\
->       \  having count(1) > 5\n\
->       \  order by s"
->      ,makeSelect
->       {qeSelectList = [(Iden [Name Nothing "a"], Nothing)
->                       ,(App [Name Nothing "sum"]
->                         [BinOp (Iden [Name Nothing "c"])
->                                [Name Nothing "+"] (Iden [Name Nothing "d"])]
->                        ,Just $ Name Nothing "s")]
->       ,qeFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]
->       ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")
->       ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
->       ,qeHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"])
->                                [Name Nothing ">"] (NumLit "5")
->       ,qeOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault]
->       }
->      )
->     ]

tools/Language/SQL/SimpleSQL/GroupBy.hs

@@ -0,0 +1,237 @@
+
+-- Here are the tests for the group by component of query exprs
+
+module Language.SQL.SimpleSQL.GroupBy (groupByTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+
+groupByTests :: TestItem
+groupByTests = Group "groupByTests"
+    [simpleGroupBy
+    ,newGroupBy
+    ,randomGroupBy
+    ]
+
+simpleGroupBy :: TestItem
+simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a,sum(b) from t group by a"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
+                                 ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]
+                 ,qeFrom = [TRSimple [Name Nothing "t"]]
+                 ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
+                 })
+
+    ,("select a,b,sum(c) from t group by a,b"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
+                                 ,(Iden [Name Nothing "b"],Nothing)
+                                 ,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)]
+                 ,qeFrom = [TRSimple [Name Nothing "t"]]
+                 ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]
+                              ,SimpleGroup $ Iden [Name Nothing "b"]]
+                 })
+    ]
+
+{-
+test the new group by (), grouping sets, cube and rollup syntax (not
+sure which sql version they were introduced, 1999 or 2003 I think).
+-}
+
+newGroupBy :: TestItem
+newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select * from t group by ()", ms [GroupingParens []])
+    ,("select * from t group by grouping sets ((), (a))"
+     ,ms [GroupingSets [GroupingParens []
+                       ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]])
+    ,("select * from t group by cube(a,b)"
+     ,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])
+    ,("select * from t group by rollup(a,b)"
+     ,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])
+    ]
+  where
+    ms g = makeSelect {qeSelectList = [(Star,Nothing)]
+                      ,qeFrom = [TRSimple [Name Nothing "t"]]
+                      ,qeGroupBy = g}
+
+randomGroupBy :: TestItem
+randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
+    ["select * from t GROUP BY a"
+    ,"select * from t GROUP BY GROUPING SETS((a))"
+    ,"select * from t GROUP BY a,b,c"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c))"
+    ,"select * from t GROUP BY ROLLUP(a,b)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b),\n\
+     \(a),\n\
+     \() )"
+    ,"select * from t GROUP BY ROLLUP(b,a)"
+    ,"select * from t GROUP BY GROUPING SETS((b,a),\n\
+     \(b),\n\
+     \() )"
+    ,"select * from t GROUP BY CUBE(a,b,c)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
+     \(a,b),\n\
+     \(a,c),\n\
+     \(b,c),\n\
+     \(a),\n\
+     \(b),\n\
+     \(c),\n\
+     \() )"
+    ,"select * from t GROUP BY ROLLUP(Province, County, City)"
+    ,"select * from t GROUP BY ROLLUP(Province, (County, City))"
+    ,"select * from t GROUP BY ROLLUP(Province, (County, City))"
+    ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
+     \(Province),\n\
+     \() )"
+    ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
+     \(Province, County),\n\
+     \(Province),\n\
+     \() )"
+    ,"select * from t GROUP BY a, ROLLUP(b,c)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
+     \(a,b),\n\
+     \(a) )"
+    ,"select * from t GROUP BY a, b, ROLLUP(c,d)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
+     \(a,b,c),\n\
+     \(a,b) )"
+    ,"select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
+     \(a,b),\n\
+     \(a),\n\
+     \(b,c),\n\
+     \(b),\n\
+     \() )"
+    ,"select * from t GROUP BY ROLLUP(a), CUBE(b,c)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
+     \(a,b),\n\
+     \(a,c),\n\
+     \(a),\n\
+     \(b,c),\n\
+     \(b),\n\
+     \(c),\n\
+     \() )"
+    ,"select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
+     \(a,b,c),\n\
+     \(a,b),\n\
+     \(a,c,d),\n\
+     \(a,c),\n\
+     \(a),\n\
+     \(b,c,d),\n\
+     \(b,c),\n\
+     \(b),\n\
+     \(c,d),\n\
+     \(c),\n\
+     \() )"
+    ,"select * from t GROUP BY a, ROLLUP(a,b)"
+    ,"select * from t GROUP BY GROUPING SETS((a,b),\n\
+     \(a) )"
+    ,"select * from t GROUP BY Region,\n\
+     \ROLLUP(Sales_Person, WEEK(Sales_Date)),\n\
+     \CUBE(YEAR(Sales_Date), MONTH (Sales_Date))"
+    ,"select * from t GROUP BY ROLLUP (Region, Sales_Person, WEEK(Sales_Date),\n\
+     \YEAR(Sales_Date), MONTH(Sales_Date) )"
+
+    ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \WHERE WEEK(SALES_DATE) = 13\n\
+     \GROUP BY WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON\n\
+     \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
+
+    ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \WHERE WEEK(SALES_DATE) = 13\n\
+     \GROUP BY GROUPING SETS ( (WEEK(SALES_DATE), SALES_PERSON),\n\
+     \(DAYOFWEEK(SALES_DATE), SALES_PERSON))\n\
+     \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
+
+    ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \WHERE WEEK(SALES_DATE) = 13\n\
+     \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
+     \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
+
+    ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \WHERE WEEK(SALES_DATE) = 13\n\
+     \GROUP BY CUBE ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
+     \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
+
+    ,"SELECT SALES_PERSON,\n\
+     \MONTH(SALES_DATE) AS MONTH,\n\
+     \SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \GROUP BY GROUPING SETS ( (SALES_PERSON, MONTH(SALES_DATE)),\n\
+     \()\n\
+     \)\n\
+     \ORDER BY SALES_PERSON, MONTH"
+
+    ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) )\n\
+     \ORDER BY WEEK, DAY_WEEK"
+
+    ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\
+     \REGION,\n\
+     \SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \GROUP BY ROLLUP ( MONTH(SALES_DATE), REGION )\n\
+     \ORDER BY MONTH, REGION"
+
+    ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \MONTH(SALES_DATE) AS MONTH,\n\
+     \REGION,\n\
+     \SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES\n\
+     \GROUP BY GROUPING SETS ( ROLLUP( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) ),\n\
+     \ROLLUP( MONTH(SALES_DATE), REGION ) )\n\
+     \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
+
+    ,"SELECT R1, R2,\n\
+     \WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \MONTH(SALES_DATE) AS MONTH,\n\
+     \REGION, SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\
+     \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\
+     \DAYOFWEEK(SALES_DATE))),\n\
+     \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
+     \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
+
+    {-,"SELECT COALESCE(R1,R2) AS GROUP,\n\
+     \WEEK(SALES_DATE) AS WEEK,\n\
+     \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
+     \MONTH(SALES_DATE) AS MONTH,\n\
+     \REGION, SUM(SALES) AS UNITS_SOLD\n\
+     \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\
+     \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\
+     \DAYOFWEEK(SALES_DATE))),\n\
+     \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
+     \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-}
+     -- as group - needs more subtle keyword blacklisting
+
+    -- decimal as a function not allowed due to the reserved keyword
+    -- handling: todo, review if this is ansi standard function or
+    -- if there are places where reserved keywords can still be used
+    ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\
+     \REGION,\n\
+     \SUM(SALES) AS UNITS_SOLD,\n\
+     \MAX(SALES) AS BEST_SALE,\n\
+     \CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\
+     \FROM SALES\n\
+     \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\
+     \ORDER BY MONTH, REGION"
+
+    ]

tools/Language/SQL/SimpleSQL/GroupBy.lhs

@@ -1,235 +0,0 @@
-
-Here are the tests for the group by component of query exprs
-
-> module Language.SQL.SimpleSQL.GroupBy (groupByTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-
-> groupByTests :: TestItem
-> groupByTests = Group "groupByTests"
->     [simpleGroupBy
->     ,newGroupBy
->     ,randomGroupBy
->     ]
-
-> simpleGroupBy :: TestItem
-> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a,sum(b) from t group by a"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
->                                  ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]
->                  ,qeFrom = [TRSimple [Name Nothing "t"]]
->                  ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
->                  })
-
->     ,("select a,b,sum(c) from t group by a,b"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
->                                  ,(Iden [Name Nothing "b"],Nothing)
->                                  ,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)]
->                  ,qeFrom = [TRSimple [Name Nothing "t"]]
->                  ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]
->                               ,SimpleGroup $ Iden [Name Nothing "b"]]
->                  })
->     ]
-
-test the new group by (), grouping sets, cube and rollup syntax (not
-sure which sql version they were introduced, 1999 or 2003 I think).
-
-> newGroupBy :: TestItem
-> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select * from t group by ()", ms [GroupingParens []])
->     ,("select * from t group by grouping sets ((), (a))"
->      ,ms [GroupingSets [GroupingParens []
->                        ,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]])
->     ,("select * from t group by cube(a,b)"
->      ,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])
->     ,("select * from t group by rollup(a,b)"
->      ,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])
->     ]
->   where
->     ms g = makeSelect {qeSelectList = [(Star,Nothing)]
->                       ,qeFrom = [TRSimple [Name Nothing "t"]]
->                       ,qeGroupBy = g}
-
-> randomGroupBy :: TestItem
-> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
->     ["select * from t GROUP BY a"
->     ,"select * from t GROUP BY GROUPING SETS((a))"
->     ,"select * from t GROUP BY a,b,c"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c))"
->     ,"select * from t GROUP BY ROLLUP(a,b)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b),\n\
->      \(a),\n\
->      \() )"
->     ,"select * from t GROUP BY ROLLUP(b,a)"
->     ,"select * from t GROUP BY GROUPING SETS((b,a),\n\
->      \(b),\n\
->      \() )"
->     ,"select * from t GROUP BY CUBE(a,b,c)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
->      \(a,b),\n\
->      \(a,c),\n\
->      \(b,c),\n\
->      \(a),\n\
->      \(b),\n\
->      \(c),\n\
->      \() )"
->     ,"select * from t GROUP BY ROLLUP(Province, County, City)"
->     ,"select * from t GROUP BY ROLLUP(Province, (County, City))"
->     ,"select * from t GROUP BY ROLLUP(Province, (County, City))"
->     ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
->      \(Province),\n\
->      \() )"
->     ,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
->      \(Province, County),\n\
->      \(Province),\n\
->      \() )"
->     ,"select * from t GROUP BY a, ROLLUP(b,c)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
->      \(a,b),\n\
->      \(a) )"
->     ,"select * from t GROUP BY a, b, ROLLUP(c,d)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
->      \(a,b,c),\n\
->      \(a,b) )"
->     ,"select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
->      \(a,b),\n\
->      \(a),\n\
->      \(b,c),\n\
->      \(b),\n\
->      \() )"
->     ,"select * from t GROUP BY ROLLUP(a), CUBE(b,c)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
->      \(a,b),\n\
->      \(a,c),\n\
->      \(a),\n\
->      \(b,c),\n\
->      \(b),\n\
->      \(c),\n\
->      \() )"
->     ,"select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
->      \(a,b,c),\n\
->      \(a,b),\n\
->      \(a,c,d),\n\
->      \(a,c),\n\
->      \(a),\n\
->      \(b,c,d),\n\
->      \(b,c),\n\
->      \(b),\n\
->      \(c,d),\n\
->      \(c),\n\
->      \() )"
->     ,"select * from t GROUP BY a, ROLLUP(a,b)"
->     ,"select * from t GROUP BY GROUPING SETS((a,b),\n\
->      \(a) )"
->     ,"select * from t GROUP BY Region,\n\
->      \ROLLUP(Sales_Person, WEEK(Sales_Date)),\n\
->      \CUBE(YEAR(Sales_Date), MONTH (Sales_Date))"
->     ,"select * from t GROUP BY ROLLUP (Region, Sales_Person, WEEK(Sales_Date),\n\
->      \YEAR(Sales_Date), MONTH(Sales_Date) )"
-
->     ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \WHERE WEEK(SALES_DATE) = 13\n\
->      \GROUP BY WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON\n\
->      \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
-
->     ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \WHERE WEEK(SALES_DATE) = 13\n\
->      \GROUP BY GROUPING SETS ( (WEEK(SALES_DATE), SALES_PERSON),\n\
->      \(DAYOFWEEK(SALES_DATE), SALES_PERSON))\n\
->      \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
-
->     ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \WHERE WEEK(SALES_DATE) = 13\n\
->      \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
->      \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
-
->     ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \WHERE WEEK(SALES_DATE) = 13\n\
->      \GROUP BY CUBE ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
->      \ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
-
->     ,"SELECT SALES_PERSON,\n\
->      \MONTH(SALES_DATE) AS MONTH,\n\
->      \SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \GROUP BY GROUPING SETS ( (SALES_PERSON, MONTH(SALES_DATE)),\n\
->      \()\n\
->      \)\n\
->      \ORDER BY SALES_PERSON, MONTH"
-
->     ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) )\n\
->      \ORDER BY WEEK, DAY_WEEK"
-
->     ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\
->      \REGION,\n\
->      \SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \GROUP BY ROLLUP ( MONTH(SALES_DATE), REGION )\n\
->      \ORDER BY MONTH, REGION"
-
->     ,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \MONTH(SALES_DATE) AS MONTH,\n\
->      \REGION,\n\
->      \SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES\n\
->      \GROUP BY GROUPING SETS ( ROLLUP( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) ),\n\
->      \ROLLUP( MONTH(SALES_DATE), REGION ) )\n\
->      \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
-
->     ,"SELECT R1, R2,\n\
->      \WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \MONTH(SALES_DATE) AS MONTH,\n\
->      \REGION, SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\
->      \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\
->      \DAYOFWEEK(SALES_DATE))),\n\
->      \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
->      \ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
-
->     {-,"SELECT COALESCE(R1,R2) AS GROUP,\n\
->      \WEEK(SALES_DATE) AS WEEK,\n\
->      \DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
->      \MONTH(SALES_DATE) AS MONTH,\n\
->      \REGION, SUM(SALES) AS UNITS_SOLD\n\
->      \FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\
->      \GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\
->      \DAYOFWEEK(SALES_DATE))),\n\
->      \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
->      \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-}
->      -- as group - needs more subtle keyword blacklisting
-
->     -- decimal as a function not allowed due to the reserved keyword
->     -- handling: todo, review if this is ansi standard function or
->     -- if there are places where reserved keywords can still be used
->     ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\
->      \REGION,\n\
->      \SUM(SALES) AS UNITS_SOLD,\n\
->      \MAX(SALES) AS BEST_SALE,\n\
->      \CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\
->      \FROM SALES\n\
->      \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\
->      \ORDER BY MONTH, REGION"
-
->     ]

tools/Language/SQL/SimpleSQL/LexerTests.hs

@@ -0,0 +1,343 @@
+
+
+-- Test for the lexer
+
+module Language.SQL.SimpleSQL.LexerTests (lexerTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Lex (Token(..),tokenListWillPrintAndLex)
+--import Debug.Trace
+--import Data.Char (isAlpha)
+import Data.List
+
+lexerTests :: TestItem
+lexerTests = Group "lexerTests" $
+    [Group "lexer token tests" [ansiLexerTests
+                               ,postgresLexerTests
+                               ,sqlServerLexerTests
+                               ,oracleLexerTests
+                               ,mySqlLexerTests
+                               ,odbcLexerTests]]
+
+ansiLexerTable :: [(String,[Token])]
+ansiLexerTable =
+    -- single char symbols
+    map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()"
+    -- multi char symbols
+    ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"]
+    ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
+        -- simple identifiers
+        in map (\i -> (i, [Identifier Nothing i])) idens
+           ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens
+           -- todo: in order to make lex . pretty id, need to
+           -- preserve the case of the u
+           ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens
+           -- host param
+           ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens
+       )
+    -- quoted identifiers with embedded double quotes
+    -- the lexer doesn't unescape the quotes
+    ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
+    -- strings
+    -- the lexer doesn't apply escapes at all
+    ++ [("'string'", [SqlString "'" "'" "string"])
+       ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
+       ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
+       ,("'\n'", [SqlString "'" "'" "\n"])]
+    -- csstrings
+    ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
+       ["n", "N","b", "B","x", "X", "u&"]
+    -- numbers
+    ++ [("10", [SqlNumber "10"])
+       ,(".1", [SqlNumber ".1"])
+       ,("5e3", [SqlNumber "5e3"])
+       ,("5e+3", [SqlNumber "5e+3"])
+       ,("5e-3", [SqlNumber "5e-3"])
+       ,("10.2", [SqlNumber "10.2"])
+       ,("10.2e7", [SqlNumber "10.2e7"])]
+    -- whitespace
+    ++ concat [[([a],[Whitespace [a]])
+               ,([a,b], [Whitespace [a,b]])]
+              | a <- " \n\t", b <- " \n\t"]
+    -- line comment
+    ++ map (\c -> (c, [LineComment c]))
+       ["--", "-- ", "-- this is a comment", "-- line com\n"]
+    -- block comment
+    ++ map (\c -> (c, [BlockComment c]))
+       ["/**/", "/* */","/* this is a comment */"
+       ,"/* this *is/ a comment */"
+       ]
+
+ansiLexerTests :: TestItem
+ansiLexerTests = Group "ansiLexerTests" $
+    [Group "ansi lexer token tests" $ [LexTest ansi2011 s t |  (s,t) <- ansiLexerTable]
+    ,Group "ansi generated combination lexer tests" $
+    [ LexTest ansi2011 (s ++ s1) (t ++ t1)
+    | (s,t) <- ansiLexerTable
+    , (s1,t1) <- ansiLexerTable
+    , tokenListWillPrintAndLex ansi2011 $ t ++ t1
+
+    ]
+    ,Group "ansiadhoclexertests" $
+       map (uncurry $ LexTest ansi2011)
+       [("", [])
+       ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"])
+       ] ++
+       [-- want to make sure this gives a parse error
+        LexFails ansi2011 "*/"
+        -- combinations of pipes: make sure they fail because they could be
+        -- ambiguous and it is really unclear when they are or not, and
+        -- what the result is even when they are not ambiguous
+       ,LexFails ansi2011 "|||"
+       ,LexFails ansi2011 "||||"
+       ,LexFails ansi2011 "|||||"
+       -- another user experience thing: make sure extra trailing
+       -- number chars are rejected rather than attempting to parse
+       -- if the user means to write something that is rejected by this code,
+       -- then they can use whitespace to make it clear and then it will parse
+       ,LexFails ansi2011 "12e3e4"
+       ,LexFails ansi2011 "12e3e4"
+       ,LexFails ansi2011 "12e3e4"
+       ,LexFails ansi2011 "12e3.4"
+       ,LexFails ansi2011 "12.4.5"
+       ,LexFails ansi2011 "12.4e5.6"
+       ,LexFails ansi2011 "12.4e5e7"]
+     ]
+
+{-
+todo: lexing tests
+do quickcheck testing:
+can try to generate valid tokens then check they parse
+
+same as above: can also try to pair tokens, create an accurate
+  function to say which ones can appear adjacent, and test
+
+I think this plus the explicit lists of tokens like above which do
+basic sanity + explicit edge casts will provide a high level of
+assurance.
+-}
+
+
+
+postgresLexerTable :: [(String,[Token])]
+postgresLexerTable =
+    -- single char symbols
+    map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;():"
+    -- multi char symbols
+    ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]
+    -- generic symbols
+
+    ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
+        -- simple identifiers
+        in map (\i -> (i, [Identifier Nothing i])) idens
+           ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens
+           -- todo: in order to make lex . pretty id, need to
+           -- preserve the case of the u
+           ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens
+           -- host param
+           ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens
+       )
+    -- positional var
+    ++ [("$1", [PositionalArg 1])]
+    -- quoted identifiers with embedded double quotes
+    ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
+    -- strings
+    ++ [("'string'", [SqlString "'" "'" "string"])
+       ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
+       ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
+       ,("'\n'", [SqlString "'" "'" "\n"])
+       ,("E'\n'", [SqlString "E'" "'" "\n"])
+       ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])
+       ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])
+       ,("'not this \\' quote", [SqlString "'" "'" "not this \\"
+                                ,Whitespace " "
+                                ,Identifier Nothing "quote"])
+       ,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])
+       ,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])
+       ,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])
+       ]
+    -- csstrings
+    ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
+       ["n", "N","b", "B","x", "X", "u&", "e", "E"]
+    -- numbers
+    ++ [("10", [SqlNumber "10"])
+       ,(".1", [SqlNumber ".1"])
+       ,("5e3", [SqlNumber "5e3"])
+       ,("5e+3", [SqlNumber "5e+3"])
+       ,("5e-3", [SqlNumber "5e-3"])
+       ,("10.2", [SqlNumber "10.2"])
+       ,("10.2e7", [SqlNumber "10.2e7"])]
+    -- whitespace
+    ++ concat [[([a],[Whitespace [a]])
+               ,([a,b], [Whitespace [a,b]])]
+              | a <- " \n\t", b <- " \n\t"]
+    -- line comment
+    ++ map (\c -> (c, [LineComment c]))
+       ["--", "-- ", "-- this is a comment", "-- line com\n"]
+    -- block comment
+    ++ map (\c -> (c, [BlockComment c]))
+       ["/**/", "/* */","/* this is a comment */"
+       ,"/* this *is/ a comment */"
+       ]
+
+{-
+An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:
+
++ - * / < > = ~ ! @ # % ^ & | ` ?
+
+There are a few restrictions on operator names, however:
+-- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.
+
+A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:
+
+~ ! @ # % ^ & | ` ?
+
+todo: 'negative' tests
+symbol then --
+symbol then /*
+operators without one of the exception chars
+  followed by + or - without whitespace
+
+also: do the testing for the ansi compatibility special cases
+-}
+
+postgresShortOperatorTable :: [(String,[Token])]
+postgresShortOperatorTable =
+    [ (x, [Symbol x]) | x <- someValidPostgresOperators 2]
+
+
+postgresExtraOperatorTable :: [(String,[Token])]
+postgresExtraOperatorTable =
+    [ (x, [Symbol x]) | x <- someValidPostgresOperators 4]
+
+
+someValidPostgresOperators :: Int -> [String]
+someValidPostgresOperators l =
+       [ x
+       | n <- [1..l]
+       , x <- combos "+-*/<>=~!@#%^&|`?" n
+       , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)
+       , not (last x `elem` "+-")
+         || or (map (`elem` x) "~!@#%^&|`?")
+       ]
+
+{-
+These are postgres operators, which if followed immediately by a + or
+-, will lex as separate operators rather than one operator including
+the + or -.
+-}
+
+somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [String]
+somePostgresOpsWhichWontAddTrailingPlusMinus l =
+       [ x
+       | n <- [1..l]
+       , x <- combos "+-*/<>=" n
+       , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)
+       , not (last x `elem` "+-")
+       ]
+
+
+postgresLexerTests :: TestItem
+postgresLexerTests = Group "postgresLexerTests" $
+    [Group "postgres lexer token tests" $
+     [LexTest postgres s t | (s,t) <- postgresLexerTable]
+    ,Group "postgres generated lexer token tests" $
+     [LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]
+    ,Group "postgres generated combination lexer tests" $
+    [ LexTest postgres (s ++ s1) (t ++ t1)
+    | (s,t) <- postgresLexerTable ++ postgresShortOperatorTable
+    , (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable
+    , tokenListWillPrintAndLex postgres $ t ++ t1
+
+    ]
+    ,Group "generated postgres edgecase lexertests" $
+     [LexTest postgres s t
+     | (s,t) <- edgeCaseCommentOps
+                ++ edgeCasePlusMinusOps
+                ++ edgeCasePlusMinusComments]
+
+    ,Group "adhoc postgres lexertests" $
+      -- need more tests for */ to make sure it is caught if it is in the middle of a
+      -- sequence of symbol letters
+        [LexFails postgres "*/"
+        ,LexFails postgres ":::"
+        ,LexFails postgres "::::"
+        ,LexFails postgres ":::::"
+        ,LexFails postgres "@*/"
+        ,LexFails postgres "-*/"
+        ,LexFails postgres "12e3e4"
+        ,LexFails postgres "12e3e4"
+        ,LexFails postgres "12e3e4"
+        ,LexFails postgres "12e3.4"
+        ,LexFails postgres "12.4.5"
+        ,LexFails postgres "12.4e5.6"
+        ,LexFails postgres "12.4e5e7"
+         -- special case allow this to lex to 1 .. 2
+         -- this is for 'for loops' in plpgsql
+        ,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]
+    ]
+ where
+   edgeCaseCommentOps =
+     [ (x ++ "/*<test*/", [Symbol x, BlockComment "/*<test*/"])
+     | x <- eccops
+     , not (last x == '*')
+     ] ++
+     [ (x ++ "--<test", [Symbol x, LineComment "--<test"])
+     | x <- eccops
+     , not (last x == '-')
+     ]
+   eccops = someValidPostgresOperators 2
+   edgeCasePlusMinusOps = concat
+     [ [ (x ++ "+", [Symbol x, Symbol "+"])
+       , (x ++ "-", [Symbol x, Symbol "-"]) ]
+     | x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2
+     ]
+   edgeCasePlusMinusComments =
+     [("---", [LineComment "---"])
+     ,("+--", [Symbol "+", LineComment "--"])
+     ,("-/**/", [Symbol "-", BlockComment "/**/"])
+     ,("+/**/", [Symbol "+", BlockComment "/**/"])
+     ]
+
+
+sqlServerLexerTests :: TestItem
+sqlServerLexerTests = Group "sqlServerLexTests" $
+    [ LexTest sqlserver s t | (s,t) <-
+    [("@variable", [(PrefixedVariable '@' "variable")])
+    ,("#variable", [(PrefixedVariable '#' "variable")])
+    ,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])
+    ]]
+
+oracleLexerTests :: TestItem
+oracleLexerTests = Group "oracleLexTests" $
+    [] -- nothing oracle specific atm
+
+mySqlLexerTests :: TestItem
+mySqlLexerTests = Group "mySqlLexerTests" $
+    [ LexTest mysql s t | (s,t) <-
+    [("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])
+    ]
+    ]
+
+odbcLexerTests :: TestItem
+odbcLexerTests = Group "odbcLexTests" $
+    [ LexTest sqlserver {diOdbc = True} s t | (s,t) <-
+    [("{}", [Symbol "{", Symbol "}"])
+    ]]
+    ++ [LexFails sqlserver {diOdbc = False} "{"
+       ,LexFails sqlserver {diOdbc = False} "}"]
+
+combos :: [a] -> Int -> [[a]]
+combos _ 0 = [[]]
+combos l n = [ x:tl | x <- l, tl <- combos l (n - 1) ]
+
+{-
+figure out a way to do quickcheck testing:
+1. generate valid tokens and check they parse
+
+2. combine two generated tokens together for the combo testing
+
+this especially will work much better for the postgresql extensible
+operator tests which doing exhaustively takes ages and doesn't bring
+much benefit over testing a few using quickcheck.
+-}

tools/Language/SQL/SimpleSQL/LexerTests.lhs

@@ -1,335 +0,0 @@
-
-
-Test for the lexer
-
-> module Language.SQL.SimpleSQL.LexerTests (lexerTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Lex (Token(..),tokenListWillPrintAndLex)
-> --import Debug.Trace
-> --import Data.Char (isAlpha)
-> import Data.List
-
-> lexerTests :: TestItem
-> lexerTests = Group "lexerTests" $
->     [Group "lexer token tests" [ansiLexerTests
->                                ,postgresLexerTests
->                                ,sqlServerLexerTests
->                                ,oracleLexerTests
->                                ,mySqlLexerTests
->                                ,odbcLexerTests]]
-
-> ansiLexerTable :: [(String,[Token])]
-> ansiLexerTable =
->     -- single char symbols
->     map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()"
->     -- multi char symbols
->     ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"]
->     ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
->         -- simple identifiers
->         in map (\i -> (i, [Identifier Nothing i])) idens
->            ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens
->            -- todo: in order to make lex . pretty id, need to
->            -- preserve the case of the u
->            ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens
->            -- host param
->            ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens
->        )
->     -- quoted identifiers with embedded double quotes
->     -- the lexer doesn't unescape the quotes
->     ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
->     -- strings
->     -- the lexer doesn't apply escapes at all
->     ++ [("'string'", [SqlString "'" "'" "string"])
->        ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
->        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
->        ,("'\n'", [SqlString "'" "'" "\n"])]
->     -- csstrings
->     ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
->        ["n", "N","b", "B","x", "X", "u&"]
->     -- numbers
->     ++ [("10", [SqlNumber "10"])
->        ,(".1", [SqlNumber ".1"])
->        ,("5e3", [SqlNumber "5e3"])
->        ,("5e+3", [SqlNumber "5e+3"])
->        ,("5e-3", [SqlNumber "5e-3"])
->        ,("10.2", [SqlNumber "10.2"])
->        ,("10.2e7", [SqlNumber "10.2e7"])]
->     -- whitespace
->     ++ concat [[([a],[Whitespace [a]])
->                ,([a,b], [Whitespace [a,b]])]
->               | a <- " \n\t", b <- " \n\t"]
->     -- line comment
->     ++ map (\c -> (c, [LineComment c]))
->        ["--", "-- ", "-- this is a comment", "-- line com\n"]
->     -- block comment
->     ++ map (\c -> (c, [BlockComment c]))
->        ["/**/", "/* */","/* this is a comment */"
->        ,"/* this *is/ a comment */"
->        ]
-
-> ansiLexerTests :: TestItem
-> ansiLexerTests = Group "ansiLexerTests" $
->     [Group "ansi lexer token tests" $ [LexTest ansi2011 s t |  (s,t) <- ansiLexerTable]
->     ,Group "ansi generated combination lexer tests" $
->     [ LexTest ansi2011 (s ++ s1) (t ++ t1)
->     | (s,t) <- ansiLexerTable
->     , (s1,t1) <- ansiLexerTable
->     , tokenListWillPrintAndLex ansi2011 $ t ++ t1
-
->     ]
->     ,Group "ansiadhoclexertests" $
->        map (uncurry $ LexTest ansi2011)
->        [("", [])
->        ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"])
->        ] ++
->        [-- want to make sure this gives a parse error
->         LexFails ansi2011 "*/"
->         -- combinations of pipes: make sure they fail because they could be
->         -- ambiguous and it is really unclear when they are or not, and
->         -- what the result is even when they are not ambiguous
->        ,LexFails ansi2011 "|||"
->        ,LexFails ansi2011 "||||"
->        ,LexFails ansi2011 "|||||"
->        -- another user experience thing: make sure extra trailing
->        -- number chars are rejected rather than attempting to parse
->        -- if the user means to write something that is rejected by this code,
->        -- then they can use whitespace to make it clear and then it will parse
->        ,LexFails ansi2011 "12e3e4"
->        ,LexFails ansi2011 "12e3e4"
->        ,LexFails ansi2011 "12e3e4"
->        ,LexFails ansi2011 "12e3.4"
->        ,LexFails ansi2011 "12.4.5"
->        ,LexFails ansi2011 "12.4e5.6"
->        ,LexFails ansi2011 "12.4e5e7"]
->      ]
-
-todo: lexing tests
-do quickcheck testing:
-can try to generate valid tokens then check they parse
-
-same as above: can also try to pair tokens, create an accurate
-  function to say which ones can appear adjacent, and test
-
-I think this plus the explicit lists of tokens like above which do
-basic sanity + explicit edge casts will provide a high level of
-assurance.
-
-
-
-> postgresLexerTable :: [(String,[Token])]
-> postgresLexerTable =
->     -- single char symbols
->     map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;():"
->     -- multi char symbols
->     ++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]
->     -- generic symbols
-
->     ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
->         -- simple identifiers
->         in map (\i -> (i, [Identifier Nothing i])) idens
->            ++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens
->            -- todo: in order to make lex . pretty id, need to
->            -- preserve the case of the u
->            ++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens
->            -- host param
->            ++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens
->        )
->     -- positional var
->     ++ [("$1", [PositionalArg 1])]
->     -- quoted identifiers with embedded double quotes
->     ++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
->     -- strings
->     ++ [("'string'", [SqlString "'" "'" "string"])
->        ,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
->        ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
->        ,("'\n'", [SqlString "'" "'" "\n"])
->        ,("E'\n'", [SqlString "E'" "'" "\n"])
->        ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])
->        ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])
->        ,("'not this \\' quote", [SqlString "'" "'" "not this \\"
->                                 ,Whitespace " "
->                                 ,Identifier Nothing "quote"])
->        ,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])
->        ,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])
->        ,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])
->        ]
->     -- csstrings
->     ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
->        ["n", "N","b", "B","x", "X", "u&", "e", "E"]
->     -- numbers
->     ++ [("10", [SqlNumber "10"])
->        ,(".1", [SqlNumber ".1"])
->        ,("5e3", [SqlNumber "5e3"])
->        ,("5e+3", [SqlNumber "5e+3"])
->        ,("5e-3", [SqlNumber "5e-3"])
->        ,("10.2", [SqlNumber "10.2"])
->        ,("10.2e7", [SqlNumber "10.2e7"])]
->     -- whitespace
->     ++ concat [[([a],[Whitespace [a]])
->                ,([a,b], [Whitespace [a,b]])]
->               | a <- " \n\t", b <- " \n\t"]
->     -- line comment
->     ++ map (\c -> (c, [LineComment c]))
->        ["--", "-- ", "-- this is a comment", "-- line com\n"]
->     -- block comment
->     ++ map (\c -> (c, [BlockComment c]))
->        ["/**/", "/* */","/* this is a comment */"
->        ,"/* this *is/ a comment */"
->        ]
-
-An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:
-
-+ - * / < > = ~ ! @ # % ^ & | ` ?
-
-There are a few restrictions on operator names, however:
--- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.
-
-A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:
-
-~ ! @ # % ^ & | ` ?
-
-todo: 'negative' tests
-symbol then --
-symbol then /*
-operators without one of the exception chars
-  followed by + or - without whitespace
-
-also: do the testing for the ansi compatibility special cases
-
-> postgresShortOperatorTable :: [(String,[Token])]
-> postgresShortOperatorTable =
->     [ (x, [Symbol x]) | x <- someValidPostgresOperators 2]
-
-
-> postgresExtraOperatorTable :: [(String,[Token])]
-> postgresExtraOperatorTable =
->     [ (x, [Symbol x]) | x <- someValidPostgresOperators 4]
-
-
-> someValidPostgresOperators :: Int -> [String]
-> someValidPostgresOperators l =
->        [ x
->        | n <- [1..l]
->        , x <- combos "+-*/<>=~!@#%^&|`?" n
->        , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)
->        , not (last x `elem` "+-")
->          || or (map (`elem` x) "~!@#%^&|`?")
->        ]
-
-These are postgres operators, which if followed immediately by a + or
--, will lex as separate operators rather than one operator including
-the + or -.
-
-> somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [String]
-> somePostgresOpsWhichWontAddTrailingPlusMinus l =
->        [ x
->        | n <- [1..l]
->        , x <- combos "+-*/<>=" n
->        , not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)
->        , not (last x `elem` "+-")
->        ]
-
-
-> postgresLexerTests :: TestItem
-> postgresLexerTests = Group "postgresLexerTests" $
->     [Group "postgres lexer token tests" $
->      [LexTest postgres s t | (s,t) <- postgresLexerTable]
->     ,Group "postgres generated lexer token tests" $
->      [LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]
->     ,Group "postgres generated combination lexer tests" $
->     [ LexTest postgres (s ++ s1) (t ++ t1)
->     | (s,t) <- postgresLexerTable ++ postgresShortOperatorTable
->     , (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable
->     , tokenListWillPrintAndLex postgres $ t ++ t1
-
->     ]
->     ,Group "generated postgres edgecase lexertests" $
->      [LexTest postgres s t
->      | (s,t) <- edgeCaseCommentOps
->                 ++ edgeCasePlusMinusOps
->                 ++ edgeCasePlusMinusComments]
-
->     ,Group "adhoc postgres lexertests" $
->       -- need more tests for */ to make sure it is caught if it is in the middle of a
->       -- sequence of symbol letters
->         [LexFails postgres "*/"
->         ,LexFails postgres ":::"
->         ,LexFails postgres "::::"
->         ,LexFails postgres ":::::"
->         ,LexFails postgres "@*/"
->         ,LexFails postgres "-*/"
->         ,LexFails postgres "12e3e4"
->         ,LexFails postgres "12e3e4"
->         ,LexFails postgres "12e3e4"
->         ,LexFails postgres "12e3.4"
->         ,LexFails postgres "12.4.5"
->         ,LexFails postgres "12.4e5.6"
->         ,LexFails postgres "12.4e5e7"
->          -- special case allow this to lex to 1 .. 2
->          -- this is for 'for loops' in plpgsql
->         ,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]
->     ]
->  where
->    edgeCaseCommentOps =
->      [ (x ++ "/*<test*/", [Symbol x, BlockComment "/*<test*/"])
->      | x <- eccops
->      , not (last x == '*')
->      ] ++
->      [ (x ++ "--<test", [Symbol x, LineComment "--<test"])
->      | x <- eccops
->      , not (last x == '-')
->      ]
->    eccops = someValidPostgresOperators 2
->    edgeCasePlusMinusOps = concat
->      [ [ (x ++ "+", [Symbol x, Symbol "+"])
->        , (x ++ "-", [Symbol x, Symbol "-"]) ]
->      | x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2
->      ]
->    edgeCasePlusMinusComments =
->      [("---", [LineComment "---"])
->      ,("+--", [Symbol "+", LineComment "--"])
->      ,("-/**/", [Symbol "-", BlockComment "/**/"])
->      ,("+/**/", [Symbol "+", BlockComment "/**/"])
->      ]
-
-
-> sqlServerLexerTests :: TestItem
-> sqlServerLexerTests = Group "sqlServerLexTests" $
->     [ LexTest sqlserver s t | (s,t) <-
->     [("@variable", [(PrefixedVariable '@' "variable")])
->     ,("#variable", [(PrefixedVariable '#' "variable")])
->     ,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])
->     ]]
-
-> oracleLexerTests :: TestItem
-> oracleLexerTests = Group "oracleLexTests" $
->     [] -- nothing oracle specific atm
-
-> mySqlLexerTests :: TestItem
-> mySqlLexerTests = Group "mySqlLexerTests" $
->     [ LexTest mysql s t | (s,t) <-
->     [("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])
->     ]
->     ]
-
-> odbcLexerTests :: TestItem
-> odbcLexerTests = Group "odbcLexTests" $
->     [ LexTest sqlserver {diOdbc = True} s t | (s,t) <-
->     [("{}", [Symbol "{", Symbol "}"])
->     ]]
->     ++ [LexFails sqlserver {diOdbc = False} "{"
->        ,LexFails sqlserver {diOdbc = False} "}"]
-
-> combos :: [a] -> Int -> [[a]]
-> combos _ 0 = [[]]
-> combos l n = [ x:tl | x <- l, tl <- combos l (n - 1) ]
-
-figure out a way to do quickcheck testing:
-1. generate valid tokens and check they parse
-
-2. combine two generated tokens together for the combo testing
-
-this especially will work much better for the postgresql extensible
-operator tests which doing exhaustively takes ages and doesn't bring
-much benefit over testing a few using quickcheck.

tools/Language/SQL/SimpleSQL/MySQL.hs

@@ -0,0 +1,42 @@
+
+-- Tests for mysql dialect parsing
+
+module Language.SQL.SimpleSQL.MySQL (mySQLTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+mySQLTests :: TestItem
+mySQLTests = Group "mysql dialect"
+    [backtickQuotes
+    ,limit]
+
+{-
+backtick quotes
+
+limit syntax
+
+[LIMIT {[offset,] row_count | row_count OFFSET offset}]
+-}
+
+backtickQuotes :: TestItem
+backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))
+    [("`test`", Iden [Name (Just ("`","`")) "test"])
+    ]
+    ++ [ParseScalarExprFails ansi2011 "`test`"]
+    )
+
+limit :: TestItem
+limit = Group "queries" ( map (uncurry (TestQueryExpr mysql))
+    [("select * from t limit 5"
+     ,sel {qeFetchFirst = Just (NumLit "5")}
+     )
+    ]
+    ++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"
+       ,ParseQueryExprFails ansi2011 "select * from t limit 5"]
+    )
+  where
+    sel = makeSelect
+          {qeSelectList = [(Star, Nothing)]
+          ,qeFrom = [TRSimple [Name Nothing "t"]]
+          }

tools/Language/SQL/SimpleSQL/MySQL.lhs

@@ -1,40 +0,0 @@
-
-Tests for mysql dialect parsing
-
-> module Language.SQL.SimpleSQL.MySQL (mySQLTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-> mySQLTests :: TestItem
-> mySQLTests = Group "mysql dialect"
->     [backtickQuotes
->     ,limit]
-
-backtick quotes
-
-limit syntax
-
-[LIMIT {[offset,] row_count | row_count OFFSET offset}]
-
-> backtickQuotes :: TestItem
-> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))
->     [("`test`", Iden [Name (Just ("`","`")) "test"])
->     ]
->     ++ [ParseScalarExprFails ansi2011 "`test`"]
->     )
-
-> limit :: TestItem
-> limit = Group "queries" ( map (uncurry (TestQueryExpr mysql))
->     [("select * from t limit 5"
->      ,sel {qeFetchFirst = Just (NumLit "5")}
->      )
->     ]
->     ++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"
->        ,ParseQueryExprFails ansi2011 "select * from t limit 5"]
->     )
->   where
->     sel = makeSelect
->           {qeSelectList = [(Star, Nothing)]
->           ,qeFrom = [TRSimple [Name Nothing "t"]]
->           }

tools/Language/SQL/SimpleSQL/Odbc.hs

@@ -0,0 +1,52 @@
+
+module Language.SQL.SimpleSQL.Odbc (odbcTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+odbcTests :: TestItem
+odbcTests = Group "odbc" [
+       Group "datetime" [
+           e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")
+          ,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")
+          ,e "{ts '2000-01-01 12:00:01.1'}"
+               (OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")
+       ]
+       ,Group "functions" [
+             e "{fn CHARACTER_LENGTH(string_exp)}"
+             $ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])
+            ,e "{fn EXTRACT(day from t)}"
+            $ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
+            ,e "{fn now()}"
+             $ OdbcFunc (ap "now" [])
+            ,e "{fn CONVERT('2000-01-01', SQL_DATE)}"
+             $ OdbcFunc (ap "CONVERT"
+              [StringLit "'" "'" "2000-01-01"
+              ,iden "SQL_DATE"])
+            ,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"
+             $ OdbcFunc (ap "CONVERT"
+              [OdbcFunc (ap "CURDATE" [])
+              ,iden "SQL_DATE"])
+            ]
+       ,Group "outer join" [
+             TestQueryExpr ansi2011 {diOdbc=True}
+             "select * from {oj t1 left outer join t2 on expr}"
+             $ makeSelect
+                   {qeSelectList = [(Star,Nothing)]
+                   ,qeFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"])
+                                         (Just $ JoinOn $ Iden [Name Nothing "expr"])]}]
+       ,Group "check parsing bugs" [
+             TestQueryExpr ansi2011 {diOdbc=True}
+             "select {fn CONVERT(cint,SQL_BIGINT)} from t;"
+             $ makeSelect
+                   {qeSelectList = [(OdbcFunc (ap "CONVERT"
+                                                      [iden "cint"
+                                                      ,iden "SQL_BIGINT"]), Nothing)]
+                   ,qeFrom = [TRSimple [Name Nothing "t"]]}]
+       ]
+  where
+    e = TestScalarExpr ansi2011 {diOdbc = True}
+    --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}
+    ap n = App [Name Nothing n]
+    iden n = Iden [Name Nothing n]
+

tools/Language/SQL/SimpleSQL/Odbc.lhs

@@ -1,52 +0,0 @@
-
-> module Language.SQL.SimpleSQL.Odbc (odbcTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-> odbcTests :: TestItem
-> odbcTests = Group "odbc" [
->        Group "datetime" [
->            e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")
->           ,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")
->           ,e "{ts '2000-01-01 12:00:01.1'}"
->                (OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")
->        ]
->        ,Group "functions" [
->              e "{fn CHARACTER_LENGTH(string_exp)}"
->              $ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])
->             ,e "{fn EXTRACT(day from t)}"
->             $ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
->             ,e "{fn now()}"
->              $ OdbcFunc (ap "now" [])
->             ,e "{fn CONVERT('2000-01-01', SQL_DATE)}"
->              $ OdbcFunc (ap "CONVERT"
->               [StringLit "'" "'" "2000-01-01"
->               ,iden "SQL_DATE"])
->             ,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"
->              $ OdbcFunc (ap "CONVERT"
->               [OdbcFunc (ap "CURDATE" [])
->               ,iden "SQL_DATE"])
->             ]
->        ,Group "outer join" [
->              TestQueryExpr ansi2011 {diOdbc=True}
->              "select * from {oj t1 left outer join t2 on expr}"
->              $ makeSelect
->                    {qeSelectList = [(Star,Nothing)]
->                    ,qeFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"])
->                                          (Just $ JoinOn $ Iden [Name Nothing "expr"])]}]
->        ,Group "check parsing bugs" [
->              TestQueryExpr ansi2011 {diOdbc=True}
->              "select {fn CONVERT(cint,SQL_BIGINT)} from t;"
->              $ makeSelect
->                    {qeSelectList = [(OdbcFunc (ap "CONVERT"
->                                                       [iden "cint"
->                                                       ,iden "SQL_BIGINT"]), Nothing)]
->                    ,qeFrom = [TRSimple [Name Nothing "t"]]}]
->        ]
->   where
->     e = TestScalarExpr ansi2011 {diOdbc = True}
->     --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}
->     ap n = App [Name Nothing n]
->     iden n = Iden [Name Nothing n]
-

tools/Language/SQL/SimpleSQL/Oracle.hs

@@ -0,0 +1,29 @@
+
+-- Tests for oracle dialect parsing
+
+module Language.SQL.SimpleSQL.Oracle (oracleTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+oracleTests :: TestItem
+oracleTests = Group "oracle dialect"
+    [oracleLobUnits]
+
+
+oracleLobUnits :: TestItem
+oracleLobUnits = Group "oracleLobUnits" (map (uncurry (TestScalarExpr oracle))
+    [("cast (a as varchar2(3 char))"
+     ,Cast (Iden [Name Nothing "a"]) (
+         PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters)))
+     ,("cast (a as varchar2(3 byte))"
+     ,Cast (Iden [Name Nothing "a"]) (
+         PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecOctets)))
+     ]
+    ++ [TestStatement oracle
+      "create table t (a varchar2(55 BYTE));"
+     $ CreateTable [Name Nothing "t"]
+       [TableColumnDef $ ColumnDef (Name Nothing "a")
+        (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))
+        Nothing []]]
+    )

tools/Language/SQL/SimpleSQL/Oracle.lhs

@@ -1,29 +0,0 @@
-
-Tests for oracle dialect parsing
-
-> module Language.SQL.SimpleSQL.Oracle (oracleTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-> oracleTests :: TestItem
-> oracleTests = Group "oracle dialect"
->     [oracleLobUnits]
-
-
-> oracleLobUnits :: TestItem
-> oracleLobUnits = Group "oracleLobUnits" (map (uncurry (TestScalarExpr oracle))
->     [("cast (a as varchar2(3 char))"
->      ,Cast (Iden [Name Nothing "a"]) (
->          PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters)))
->      ,("cast (a as varchar2(3 byte))"
->      ,Cast (Iden [Name Nothing "a"]) (
->          PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecOctets)))
->      ]
->     ++ [TestStatement oracle
->       "create table t (a varchar2(55 BYTE));"
->      $ CreateTable [Name Nothing "t"]
->        [TableColumnDef $ ColumnDef (Name Nothing "a")
->         (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))
->         Nothing []]]
->     )

tools/Language/SQL/SimpleSQL/Postgres.hs

@@ -0,0 +1,278 @@
+
+{-
+Here are some tests taken from the SQL in the postgres manual. Almost
+all of the postgres specific syntax has been skipped, this can be
+revisited when the dialect support is added.
+-}
+
+module Language.SQL.SimpleSQL.Postgres (postgresTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+
+postgresTests :: TestItem
+postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)
+
+{-
+lexical syntax section
+
+TODO: get all the commented out tests working
+-}
+
+    [-- "SELECT 'foo'\n\
+    -- \'bar';" -- this should parse as select 'foobar'
+    -- ,
+     "SELECT name, (SELECT max(pop) FROM cities\n\
+     \ WHERE cities.state = states.name)\n\
+     \    FROM states;"
+    ,"SELECT ROW(1,2.5,'this is a test');"
+
+    ,"SELECT ROW(t.*, 42) FROM t;"
+    ,"SELECT ROW(t.f1, t.f2, 42) FROM t;"
+    ,"SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));"
+
+    ,"SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');"
+
+    -- table is a reservered keyword?
+    --,"SELECT ROW(table.*) IS NULL FROM table;"
+    ,"SELECT ROW(tablex.*) IS NULL FROM tablex;"
+
+    ,"SELECT true OR somefunc();"
+
+    ,"SELECT somefunc() OR true;"
+
+-- queries section
+
+    ,"SELECT * FROM t1 CROSS JOIN t2;"
+    ,"SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"
+    ,"SELECT * FROM t1 INNER JOIN t2 USING (num);"
+    ,"SELECT * FROM t1 NATURAL INNER JOIN t2;"
+    ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"
+    ,"SELECT * FROM t1 LEFT JOIN t2 USING (num);"
+    ,"SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"
+    ,"SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"
+    ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"
+    ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"
+
+    ,"SELECT * FROM some_very_long_table_name s\n\
+     \JOIN another_fairly_long_name a ON s.id = a.num;"
+    ,"SELECT * FROM people AS mother JOIN people AS child\n\
+     \ ON mother.id = child.mother_id;"
+    ,"SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"
+    ,"SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"
+    ,"SELECT * FROM getfoo(1) AS t1;"
+    ,"SELECT * FROM foo\n\
+     \    WHERE foosubid IN (\n\
+     \                        SELECT foosubid\n\
+     \                        FROM getfoo(foo.fooid) z\n\
+     \                        WHERE z.fooid = foo.fooid\n\
+     \                      );"
+    {-,"SELECT *\n\
+     \    FROM dblink('dbname=mydb', 'SELECT proname, prosrc FROM pg_proc')\n\
+     \      AS t1(proname name, prosrc text)\n\
+     \    WHERE proname LIKE 'bytea%';"-} -- types in the alias??
+
+    ,"SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"
+    ,"SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"
+
+    {-,"SELECT p1.id, p2.id, v1, v2\n\
+     \FROM polygons p1, polygons p2,\n\
+     \     LATERAL vertices(p1.poly) v1,\n\
+     \     LATERAL vertices(p2.poly) v2\n\
+     \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-} -- <-> operator?
+
+    {-,"SELECT p1.id, p2.id, v1, v2\n\
+     \FROM polygons p1 CROSS JOIN LATERAL vertices(p1.poly) v1,\n\
+     \     polygons p2 CROSS JOIN LATERAL vertices(p2.poly) v2\n\
+     \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-}
+
+    ,"SELECT m.name\n\
+     \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true\n\
+     \WHERE pname IS NULL;"
+
+
+    ,"SELECT * FROM fdt WHERE c1 > 5"
+
+    ,"SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"
+
+    ,"SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"
+
+    ,"SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"
+
+    ,"SELECT * FROM fdt WHERE c1 BETWEEN \n\
+     \    (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100"
+
+    ,"SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"
+
+    ,"SELECT * FROM test1;"
+
+    ,"SELECT x FROM test1 GROUP BY x;"
+    ,"SELECT x, sum(y) FROM test1 GROUP BY x;"
+    -- s.date changed to s.datex because of reserved keyword
+    -- handling, not sure if this is correct or not for ansi sql
+    ,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\
+     \    FROM products p LEFT JOIN sales s USING (product_id)\n\
+     \    GROUP BY product_id, p.name, p.price;"
+
+    ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"
+    ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"
+    ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\
+     \    FROM products p LEFT JOIN sales s USING (product_id)\n\
+     \    WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\
+     \    GROUP BY product_id, p.name, p.price, p.cost\n\
+     \    HAVING sum(p.price * s.units) > 5000;"
+
+    ,"SELECT a, b, c FROM t"
+
+    ,"SELECT tbl1.a, tbl2.a, tbl1.b FROM t"
+
+    ,"SELECT tbl1.*, tbl2.a FROM t"
+
+    ,"SELECT a AS value, b + c AS sum FROM t"
+
+    ,"SELECT a \"value\", b + c AS sum FROM t"
+
+    ,"SELECT DISTINCT select_list t"
+
+    ,"VALUES (1, 'one'), (2, 'two'), (3, 'three');"
+
+    ,"SELECT 1 AS column1, 'one' AS column2\n\
+     \UNION ALL\n\
+     \SELECT 2, 'two'\n\
+     \UNION ALL\n\
+     \SELECT 3, 'three';"
+
+    ,"SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"
+
+    ,"WITH regional_sales AS (\n\
+     \        SELECT region, SUM(amount) AS total_sales\n\
+     \        FROM orders\n\
+     \        GROUP BY region\n\
+     \     ), top_regions AS (\n\
+     \        SELECT region\n\
+     \        FROM regional_sales\n\
+     \        WHERE total_sales > (SELECT SUM(total_sales)/10 FROM regional_sales)\n\
+     \     )\n\
+     \SELECT region,\n\
+     \       product,\n\
+     \       SUM(quantity) AS product_units,\n\
+     \       SUM(amount) AS product_sales\n\
+     \FROM orders\n\
+     \WHERE region IN (SELECT region FROM top_regions)\n\
+     \GROUP BY region, product;"
+
+    ,"WITH RECURSIVE t(n) AS (\n\
+     \    VALUES (1)\n\
+     \  UNION ALL\n\
+     \    SELECT n+1 FROM t WHERE n < 100\n\
+     \)\n\
+     \SELECT sum(n) FROM t"
+
+    ,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\
+     \    SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'\n\
+     \  UNION ALL\n\
+     \    SELECT p.sub_part, p.part, p.quantity\n\
+     \    FROM included_parts pr, parts p\n\
+     \    WHERE p.part = pr.sub_part\n\
+     \  )\n\
+     \SELECT sub_part, SUM(quantity) as total_quantity\n\
+     \FROM included_parts\n\
+     \GROUP BY sub_part"
+
+    ,"WITH RECURSIVE search_graph(id, link, data, depth) AS (\n\
+     \        SELECT g.id, g.link, g.data, 1\n\
+     \        FROM graph g\n\
+     \      UNION ALL\n\
+     \        SELECT g.id, g.link, g.data, sg.depth + 1\n\
+     \        FROM graph g, search_graph sg\n\
+     \        WHERE g.id = sg.link\n\
+     \)\n\
+     \SELECT * FROM search_graph;"
+
+    {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
+     \        SELECT g.id, g.link, g.data, 1,\n\
+     \          ARRAY[g.id],\n\
+     \          false\n\
+     \        FROM graph g\n\
+     \      UNION ALL\n\
+     \        SELECT g.id, g.link, g.data, sg.depth + 1,\n\
+     \          path || g.id,\n\
+     \          g.id = ANY(path)\n\
+     \        FROM graph g, search_graph sg\n\
+     \        WHERE g.id = sg.link AND NOT cycle\n\
+     \)\n\
+     \SELECT * FROM search_graph;"-} -- ARRAY
+
+    {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
+     \        SELECT g.id, g.link, g.data, 1,\n\
+     \          ARRAY[ROW(g.f1, g.f2)],\n\
+     \          false\n\
+     \        FROM graph g\n\
+     \      UNION ALL\n\
+     \        SELECT g.id, g.link, g.data, sg.depth + 1,\n\
+     \          path || ROW(g.f1, g.f2),\n\
+     \          ROW(g.f1, g.f2) = ANY(path)\n\
+     \        FROM graph g, search_graph sg\n\
+     \        WHERE g.id = sg.link AND NOT cycle\n\
+     \)\n\
+     \SELECT * FROM search_graph;"-} -- ARRAY
+
+    ,"WITH RECURSIVE t(n) AS (\n\
+     \    SELECT 1\n\
+     \  UNION ALL\n\
+     \    SELECT n+1 FROM t\n\
+     \)\n\
+     \SELECT n FROM t --LIMIT 100;" -- limit is not standard
+
+-- select page reference
+
+    ,"SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\
+     \    FROM distributors d, films f\n\
+     \    WHERE f.did = d.did"
+
+    ,"SELECT kind, sum(len) AS total\n\
+     \    FROM films\n\
+     \    GROUP BY kind\n\
+     \    HAVING sum(len) < interval '5 hours';"
+
+    ,"SELECT * FROM distributors ORDER BY name;"
+    ,"SELECT * FROM distributors ORDER BY 2;"
+
+    ,"SELECT distributors.name\n\
+     \    FROM distributors\n\
+     \    WHERE distributors.name LIKE 'W%'\n\
+     \UNION\n\
+     \SELECT actors.name\n\
+     \    FROM actors\n\
+     \    WHERE actors.name LIKE 'W%';"
+
+    ,"WITH t AS (\n\
+     \    SELECT random() as x FROM generate_series(1, 3)\n\
+     \  )\n\
+     \SELECT * FROM t\n\
+     \UNION ALL\n\
+     \SELECT * FROM t"
+
+    ,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\
+     \    SELECT 1, employee_name, manager_name\n\
+     \    FROM employee\n\
+     \    WHERE manager_name = 'Mary'\n\
+     \  UNION ALL\n\
+     \    SELECT er.distance + 1, e.employee_name, e.manager_name\n\
+     \    FROM employee_recursive er, employee e\n\
+     \    WHERE er.employee_name = e.manager_name\n\
+     \  )\n\
+     \SELECT distance, employee_name FROM employee_recursive;"
+
+    ,"SELECT m.name AS mname, pname\n\
+     \FROM manufacturers m, LATERAL get_product_names(m.id) pname;"
+
+    ,"SELECT m.name AS mname, pname\n\
+     \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"
+
+    ,"SELECT 2+2;"
+
+    -- simple-sql-parser doesn't support where without from
+    -- this can be added for the postgres dialect when it is written
+    --,"SELECT distributors.* WHERE distributors.name = 'Westward';"
+
+    ]

tools/Language/SQL/SimpleSQL/Postgres.lhs

@@ -1,274 +0,0 @@
-
-Here are some tests taken from the SQL in the postgres manual. Almost
-all of the postgres specific syntax has been skipped, this can be
-revisited when the dialect support is added.
-
-> module Language.SQL.SimpleSQL.Postgres (postgresTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-
-> postgresTests :: TestItem
-> postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)
-
-lexical syntax section
-
-TODO: get all the commented out tests working
-
->     [-- "SELECT 'foo'\n\
->     -- \'bar';" -- this should parse as select 'foobar'
->     -- ,
->      "SELECT name, (SELECT max(pop) FROM cities\n\
->      \ WHERE cities.state = states.name)\n\
->      \    FROM states;"
->     ,"SELECT ROW(1,2.5,'this is a test');"
-
->     ,"SELECT ROW(t.*, 42) FROM t;"
->     ,"SELECT ROW(t.f1, t.f2, 42) FROM t;"
->     ,"SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));"
-
->     ,"SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');"
-
->     -- table is a reservered keyword?
->     --,"SELECT ROW(table.*) IS NULL FROM table;"
->     ,"SELECT ROW(tablex.*) IS NULL FROM tablex;"
-
->     ,"SELECT true OR somefunc();"
-
->     ,"SELECT somefunc() OR true;"
-
-queries section
-
->     ,"SELECT * FROM t1 CROSS JOIN t2;"
->     ,"SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"
->     ,"SELECT * FROM t1 INNER JOIN t2 USING (num);"
->     ,"SELECT * FROM t1 NATURAL INNER JOIN t2;"
->     ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"
->     ,"SELECT * FROM t1 LEFT JOIN t2 USING (num);"
->     ,"SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"
->     ,"SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"
->     ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"
->     ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"
-
->     ,"SELECT * FROM some_very_long_table_name s\n\
->      \JOIN another_fairly_long_name a ON s.id = a.num;"
->     ,"SELECT * FROM people AS mother JOIN people AS child\n\
->      \ ON mother.id = child.mother_id;"
->     ,"SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"
->     ,"SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"
->     ,"SELECT * FROM getfoo(1) AS t1;"
->     ,"SELECT * FROM foo\n\
->      \    WHERE foosubid IN (\n\
->      \                        SELECT foosubid\n\
->      \                        FROM getfoo(foo.fooid) z\n\
->      \                        WHERE z.fooid = foo.fooid\n\
->      \                      );"
->     {-,"SELECT *\n\
->      \    FROM dblink('dbname=mydb', 'SELECT proname, prosrc FROM pg_proc')\n\
->      \      AS t1(proname name, prosrc text)\n\
->      \    WHERE proname LIKE 'bytea%';"-} -- types in the alias??
-
->     ,"SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"
->     ,"SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"
-
->     {-,"SELECT p1.id, p2.id, v1, v2\n\
->      \FROM polygons p1, polygons p2,\n\
->      \     LATERAL vertices(p1.poly) v1,\n\
->      \     LATERAL vertices(p2.poly) v2\n\
->      \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-} -- <-> operator?
-
->     {-,"SELECT p1.id, p2.id, v1, v2\n\
->      \FROM polygons p1 CROSS JOIN LATERAL vertices(p1.poly) v1,\n\
->      \     polygons p2 CROSS JOIN LATERAL vertices(p2.poly) v2\n\
->      \WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-}
-
->     ,"SELECT m.name\n\
->      \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true\n\
->      \WHERE pname IS NULL;"
-
-
->     ,"SELECT * FROM fdt WHERE c1 > 5"
-
->     ,"SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"
-
->     ,"SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"
-
->     ,"SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"
-
->     ,"SELECT * FROM fdt WHERE c1 BETWEEN \n\
->      \    (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100"
-
->     ,"SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"
-
->     ,"SELECT * FROM test1;"
-
->     ,"SELECT x FROM test1 GROUP BY x;"
->     ,"SELECT x, sum(y) FROM test1 GROUP BY x;"
->     -- s.date changed to s.datex because of reserved keyword
->     -- handling, not sure if this is correct or not for ansi sql
->     ,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\
->      \    FROM products p LEFT JOIN sales s USING (product_id)\n\
->      \    GROUP BY product_id, p.name, p.price;"
-
->     ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"
->     ,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"
->     ,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\
->      \    FROM products p LEFT JOIN sales s USING (product_id)\n\
->      \    WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\
->      \    GROUP BY product_id, p.name, p.price, p.cost\n\
->      \    HAVING sum(p.price * s.units) > 5000;"
-
->     ,"SELECT a, b, c FROM t"
-
->     ,"SELECT tbl1.a, tbl2.a, tbl1.b FROM t"
-
->     ,"SELECT tbl1.*, tbl2.a FROM t"
-
->     ,"SELECT a AS value, b + c AS sum FROM t"
-
->     ,"SELECT a \"value\", b + c AS sum FROM t"
-
->     ,"SELECT DISTINCT select_list t"
-
->     ,"VALUES (1, 'one'), (2, 'two'), (3, 'three');"
-
->     ,"SELECT 1 AS column1, 'one' AS column2\n\
->      \UNION ALL\n\
->      \SELECT 2, 'two'\n\
->      \UNION ALL\n\
->      \SELECT 3, 'three';"
-
->     ,"SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"
-
->     ,"WITH regional_sales AS (\n\
->      \        SELECT region, SUM(amount) AS total_sales\n\
->      \        FROM orders\n\
->      \        GROUP BY region\n\
->      \     ), top_regions AS (\n\
->      \        SELECT region\n\
->      \        FROM regional_sales\n\
->      \        WHERE total_sales > (SELECT SUM(total_sales)/10 FROM regional_sales)\n\
->      \     )\n\
->      \SELECT region,\n\
->      \       product,\n\
->      \       SUM(quantity) AS product_units,\n\
->      \       SUM(amount) AS product_sales\n\
->      \FROM orders\n\
->      \WHERE region IN (SELECT region FROM top_regions)\n\
->      \GROUP BY region, product;"
-
->     ,"WITH RECURSIVE t(n) AS (\n\
->      \    VALUES (1)\n\
->      \  UNION ALL\n\
->      \    SELECT n+1 FROM t WHERE n < 100\n\
->      \)\n\
->      \SELECT sum(n) FROM t"
-
->     ,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\
->      \    SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'\n\
->      \  UNION ALL\n\
->      \    SELECT p.sub_part, p.part, p.quantity\n\
->      \    FROM included_parts pr, parts p\n\
->      \    WHERE p.part = pr.sub_part\n\
->      \  )\n\
->      \SELECT sub_part, SUM(quantity) as total_quantity\n\
->      \FROM included_parts\n\
->      \GROUP BY sub_part"
-
->     ,"WITH RECURSIVE search_graph(id, link, data, depth) AS (\n\
->      \        SELECT g.id, g.link, g.data, 1\n\
->      \        FROM graph g\n\
->      \      UNION ALL\n\
->      \        SELECT g.id, g.link, g.data, sg.depth + 1\n\
->      \        FROM graph g, search_graph sg\n\
->      \        WHERE g.id = sg.link\n\
->      \)\n\
->      \SELECT * FROM search_graph;"
-
->     {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
->      \        SELECT g.id, g.link, g.data, 1,\n\
->      \          ARRAY[g.id],\n\
->      \          false\n\
->      \        FROM graph g\n\
->      \      UNION ALL\n\
->      \        SELECT g.id, g.link, g.data, sg.depth + 1,\n\
->      \          path || g.id,\n\
->      \          g.id = ANY(path)\n\
->      \        FROM graph g, search_graph sg\n\
->      \        WHERE g.id = sg.link AND NOT cycle\n\
->      \)\n\
->      \SELECT * FROM search_graph;"-} -- ARRAY
-
->     {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
->      \        SELECT g.id, g.link, g.data, 1,\n\
->      \          ARRAY[ROW(g.f1, g.f2)],\n\
->      \          false\n\
->      \        FROM graph g\n\
->      \      UNION ALL\n\
->      \        SELECT g.id, g.link, g.data, sg.depth + 1,\n\
->      \          path || ROW(g.f1, g.f2),\n\
->      \          ROW(g.f1, g.f2) = ANY(path)\n\
->      \        FROM graph g, search_graph sg\n\
->      \        WHERE g.id = sg.link AND NOT cycle\n\
->      \)\n\
->      \SELECT * FROM search_graph;"-} -- ARRAY
-
->     ,"WITH RECURSIVE t(n) AS (\n\
->      \    SELECT 1\n\
->      \  UNION ALL\n\
->      \    SELECT n+1 FROM t\n\
->      \)\n\
->      \SELECT n FROM t --LIMIT 100;" -- limit is not standard
-
-select page reference
-
->     ,"SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\
->      \    FROM distributors d, films f\n\
->      \    WHERE f.did = d.did"
-
->     ,"SELECT kind, sum(len) AS total\n\
->      \    FROM films\n\
->      \    GROUP BY kind\n\
->      \    HAVING sum(len) < interval '5 hours';"
-
->     ,"SELECT * FROM distributors ORDER BY name;"
->     ,"SELECT * FROM distributors ORDER BY 2;"
-
->     ,"SELECT distributors.name\n\
->      \    FROM distributors\n\
->      \    WHERE distributors.name LIKE 'W%'\n\
->      \UNION\n\
->      \SELECT actors.name\n\
->      \    FROM actors\n\
->      \    WHERE actors.name LIKE 'W%';"
-
->     ,"WITH t AS (\n\
->      \    SELECT random() as x FROM generate_series(1, 3)\n\
->      \  )\n\
->      \SELECT * FROM t\n\
->      \UNION ALL\n\
->      \SELECT * FROM t"
-
->     ,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\
->      \    SELECT 1, employee_name, manager_name\n\
->      \    FROM employee\n\
->      \    WHERE manager_name = 'Mary'\n\
->      \  UNION ALL\n\
->      \    SELECT er.distance + 1, e.employee_name, e.manager_name\n\
->      \    FROM employee_recursive er, employee e\n\
->      \    WHERE er.employee_name = e.manager_name\n\
->      \  )\n\
->      \SELECT distance, employee_name FROM employee_recursive;"
-
->     ,"SELECT m.name AS mname, pname\n\
->      \FROM manufacturers m, LATERAL get_product_names(m.id) pname;"
-
->     ,"SELECT m.name AS mname, pname\n\
->      \FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"
-
->     ,"SELECT 2+2;"
-
->     -- simple-sql-parser doesn't support where without from
->     -- this can be added for the postgres dialect when it is written
->     --,"SELECT distributors.* WHERE distributors.name = 'Westward';"
-
->     ]

tools/Language/SQL/SimpleSQL/QueryExprComponents.hs

@@ -0,0 +1,211 @@
+
+{-
+These are the tests for the query expression components apart from the
+table refs which are in a separate file.
+
+
+These are a few misc tests which don't fit anywhere else.
+-}
+
+module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+
+queryExprComponentTests :: TestItem
+queryExprComponentTests = Group "queryExprComponentTests"
+    [duplicates
+    ,selectLists
+    ,whereClause
+    ,having
+    ,orderBy
+    ,offsetFetch
+    ,combos
+    ,withQueries
+    ,values
+    ,tables
+    ]
+
+
+
+duplicates :: TestItem
+duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a from t" ,ms SQDefault)
+    ,("select all a from t" ,ms All)
+    ,("select distinct a from t", ms Distinct)
+    ]
+ where
+   ms d = makeSelect
+          {qeSetQuantifier = d
+          ,qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+          ,qeFrom = [TRSimple [Name Nothing "t"]]}
+
+selectLists :: TestItem
+selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select 1",
+      makeSelect {qeSelectList = [(NumLit "1",Nothing)]})
+
+    ,("select a"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]})
+
+    ,("select a,b"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
+                                 ,(Iden [Name Nothing "b"],Nothing)]})
+
+    ,("select 1+2,3+4"
+     ,makeSelect {qeSelectList =
+                     [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)
+                     ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]})
+
+    ,("select a as a, /*comment*/ b as b"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")
+                                 ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})
+
+    ,("select a a, b b"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")
+                                 ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})
+
+    ,("select a + b * c"
+     ,makeSelect {qeSelectList =
+      [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]
+        (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))
+       ,Nothing)]})
+
+    ]
+
+whereClause :: TestItem
+whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a from t where a = 5"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+                 ,qeFrom = [TRSimple [Name Nothing "t"]]
+                 ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})
+    ]
+
+having :: TestItem
+having = Group "having" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a,sum(b) from t group by a having sum(b) > 5"
+     ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
+                                 ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]
+                 ,qeFrom = [TRSimple [Name Nothing "t"]]
+                 ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
+                 ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]])
+                                          [Name Nothing ">"] (NumLit "5")
+                 })
+    ]
+
+orderBy :: TestItem
+orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a from t order by a"
+     ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault])
+
+    ,("select a from t order by a, b"
+     ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault
+         ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault])
+
+    ,("select a from t order by a asc"
+     ,ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault])
+
+    ,("select a from t order by a desc, b desc"
+     ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault
+         ,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault])
+
+    ,("select a from t order by a desc nulls first, b desc nulls last"
+     ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst
+         ,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast])
+
+    ]
+  where
+    ms o = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+                      ,qeFrom = [TRSimple [Name Nothing "t"]]
+                      ,qeOrderBy = o}
+
+offsetFetch :: TestItem
+offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))
+    [-- ansi standard
+     ("select a from t offset 5 rows fetch next 10 rows only"
+     ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
+    ,("select a from t offset 5 rows;"
+     ,ms (Just $ NumLit "5") Nothing)
+    ,("select a from t fetch next 10 row only;"
+     ,ms Nothing (Just $ NumLit "10"))
+    ,("select a from t offset 5 row fetch first 10 row only"
+     ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
+     -- postgres: disabled, will add back when postgres
+     -- dialect is added
+    --,("select a from t limit 10 offset 5"
+    -- ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
+    ]
+  where
+    ms o l = makeSelect
+             {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+             ,qeFrom = [TRSimple [Name Nothing "t"]]
+             ,qeOffset = o
+             ,qeFetchFirst = l}
+
+combos :: TestItem
+combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a from t union select b from u"
+     ,QueryExprSetOp ms1 Union SQDefault Respectively ms2)
+
+    ,("select a from t intersect select b from u"
+     ,QueryExprSetOp ms1 Intersect SQDefault Respectively ms2)
+
+    ,("select a from t except all select b from u"
+     ,QueryExprSetOp ms1 Except All Respectively ms2)
+
+    ,("select a from t union distinct corresponding \
+      \select b from u"
+     ,QueryExprSetOp ms1 Union Distinct Corresponding ms2)
+
+    ,("select a from t union select a from t union select a from t"
+     -- TODO: union should be left associative. I think the others also
+     -- so this needs to be fixed (new optionSuffix variation which
+     -- handles this)
+     ,QueryExprSetOp ms1 Union SQDefault Respectively
+       (QueryExprSetOp ms1 Union SQDefault Respectively ms1))
+    ]
+  where
+    ms1 = makeSelect
+          {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+          ,qeFrom = [TRSimple [Name Nothing "t"]]}
+    ms2 = makeSelect
+          {qeSelectList = [(Iden [Name Nothing "b"],Nothing)]
+          ,qeFrom = [TRSimple [Name Nothing "u"]]}
+
+
+withQueries :: TestItem
+withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))
+    [("with u as (select a from t) select a from u"
+     ,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2)
+
+    ,("with u(b) as (select a from t) select a from u"
+     ,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2)
+
+    ,("with x as (select a from t),\n\
+      \     u as (select a from x)\n\
+      \select a from u"
+     ,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2)
+
+    ,("with recursive u as (select a from t) select a from u"
+     ,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2)
+    ]
+ where
+   ms c t = makeSelect
+            {qeSelectList = [(Iden [Name Nothing c],Nothing)]
+            ,qeFrom = [TRSimple [Name Nothing t]]}
+   ms1 = ms "a" "t"
+   ms2 = ms "a" "u"
+   ms3 = ms "a" "x"
+
+values :: TestItem
+values = Group "values" $ map (uncurry (TestQueryExpr ansi2011))
+    [("values (1,2),(3,4)"
+      ,Values [[NumLit "1", NumLit "2"]
+              ,[NumLit "3", NumLit "4"]])
+    ]
+
+tables :: TestItem
+tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))
+    [("table tbl", Table [Name Nothing "tbl"])
+    ]

tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs

@@ -1,209 +0,0 @@
-
-These are the tests for the query expression components apart from the
-table refs which are in a separate file.
-
-
-These are a few misc tests which don't fit anywhere else.
-
-> module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-
-> queryExprComponentTests :: TestItem
-> queryExprComponentTests = Group "queryExprComponentTests"
->     [duplicates
->     ,selectLists
->     ,whereClause
->     ,having
->     ,orderBy
->     ,offsetFetch
->     ,combos
->     ,withQueries
->     ,values
->     ,tables
->     ]
-
-
-
-> duplicates :: TestItem
-> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a from t" ,ms SQDefault)
->     ,("select all a from t" ,ms All)
->     ,("select distinct a from t", ms Distinct)
->     ]
->  where
->    ms d = makeSelect
->           {qeSetQuantifier = d
->           ,qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->           ,qeFrom = [TRSimple [Name Nothing "t"]]}
-
-> selectLists :: TestItem
-> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select 1",
->       makeSelect {qeSelectList = [(NumLit "1",Nothing)]})
-
->     ,("select a"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]})
-
->     ,("select a,b"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
->                                  ,(Iden [Name Nothing "b"],Nothing)]})
-
->     ,("select 1+2,3+4"
->      ,makeSelect {qeSelectList =
->                      [(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)
->                      ,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]})
-
->     ,("select a as a, /*comment*/ b as b"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")
->                                  ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})
-
->     ,("select a a, b b"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")
->                                  ,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})
-
->     ,("select a + b * c"
->      ,makeSelect {qeSelectList =
->       [(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]
->         (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))
->        ,Nothing)]})
-
->     ]
-
-> whereClause :: TestItem
-> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a from t where a = 5"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->                  ,qeFrom = [TRSimple [Name Nothing "t"]]
->                  ,qeWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})
->     ]
-
-> having :: TestItem
-> having = Group "having" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a,sum(b) from t group by a having sum(b) > 5"
->      ,makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)
->                                  ,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]
->                  ,qeFrom = [TRSimple [Name Nothing "t"]]
->                  ,qeGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
->                  ,qeHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]])
->                                           [Name Nothing ">"] (NumLit "5")
->                  })
->     ]
-
-> orderBy :: TestItem
-> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a from t order by a"
->      ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault])
-
->     ,("select a from t order by a, b"
->      ,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault
->          ,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault])
-
->     ,("select a from t order by a asc"
->      ,ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault])
-
->     ,("select a from t order by a desc, b desc"
->      ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault
->          ,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault])
-
->     ,("select a from t order by a desc nulls first, b desc nulls last"
->      ,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst
->          ,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast])
-
->     ]
->   where
->     ms o = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->                       ,qeFrom = [TRSimple [Name Nothing "t"]]
->                       ,qeOrderBy = o}
-
-> offsetFetch :: TestItem
-> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))
->     [-- ansi standard
->      ("select a from t offset 5 rows fetch next 10 rows only"
->      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
->     ,("select a from t offset 5 rows;"
->      ,ms (Just $ NumLit "5") Nothing)
->     ,("select a from t fetch next 10 row only;"
->      ,ms Nothing (Just $ NumLit "10"))
->     ,("select a from t offset 5 row fetch first 10 row only"
->      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
->      -- postgres: disabled, will add back when postgres
->      -- dialect is added
->     --,("select a from t limit 10 offset 5"
->     -- ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
->     ]
->   where
->     ms o l = makeSelect
->              {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->              ,qeFrom = [TRSimple [Name Nothing "t"]]
->              ,qeOffset = o
->              ,qeFetchFirst = l}
-
-> combos :: TestItem
-> combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a from t union select b from u"
->      ,QueryExprSetOp ms1 Union SQDefault Respectively ms2)
-
->     ,("select a from t intersect select b from u"
->      ,QueryExprSetOp ms1 Intersect SQDefault Respectively ms2)
-
->     ,("select a from t except all select b from u"
->      ,QueryExprSetOp ms1 Except All Respectively ms2)
-
->     ,("select a from t union distinct corresponding \
->       \select b from u"
->      ,QueryExprSetOp ms1 Union Distinct Corresponding ms2)
-
->     ,("select a from t union select a from t union select a from t"
->      -- TODO: union should be left associative. I think the others also
->      -- so this needs to be fixed (new optionSuffix variation which
->      -- handles this)
->      ,QueryExprSetOp ms1 Union SQDefault Respectively
->        (QueryExprSetOp ms1 Union SQDefault Respectively ms1))
->     ]
->   where
->     ms1 = makeSelect
->           {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->           ,qeFrom = [TRSimple [Name Nothing "t"]]}
->     ms2 = makeSelect
->           {qeSelectList = [(Iden [Name Nothing "b"],Nothing)]
->           ,qeFrom = [TRSimple [Name Nothing "u"]]}
-
-
-> withQueries :: TestItem
-> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))
->     [("with u as (select a from t) select a from u"
->      ,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2)
-
->     ,("with u(b) as (select a from t) select a from u"
->      ,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2)
-
->     ,("with x as (select a from t),\n\
->       \     u as (select a from x)\n\
->       \select a from u"
->      ,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2)
-
->     ,("with recursive u as (select a from t) select a from u"
->      ,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2)
->     ]
->  where
->    ms c t = makeSelect
->             {qeSelectList = [(Iden [Name Nothing c],Nothing)]
->             ,qeFrom = [TRSimple [Name Nothing t]]}
->    ms1 = ms "a" "t"
->    ms2 = ms "a" "u"
->    ms3 = ms "a" "x"
-
-> values :: TestItem
-> values = Group "values" $ map (uncurry (TestQueryExpr ansi2011))
->     [("values (1,2),(3,4)"
->       ,Values [[NumLit "1", NumLit "2"]
->               ,[NumLit "3", NumLit "4"]])
->     ]
-
-> tables :: TestItem
-> tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))
->     [("table tbl", Table [Name Nothing "tbl"])
->     ]

tools/Language/SQL/SimpleSQL/QueryExprs.hs

@@ -0,0 +1,26 @@
+
+{-
+These are the tests for the queryExprs parsing which parses multiple
+query expressions from one string.
+-}
+
+module Language.SQL.SimpleSQL.QueryExprs (queryExprsTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+queryExprsTests :: TestItem
+queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011))
+    [("select 1",[ms])
+    ,("select 1;",[ms])
+    ,("select 1;select 1",[ms,ms])
+    ,(" select 1;select 1; ",[ms,ms])
+    ,("SELECT CURRENT_TIMESTAMP;"
+     ,[SelectStatement $ makeSelect
+      {qeSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}])
+    ,("SELECT \"CURRENT_TIMESTAMP\";"
+     ,[SelectStatement $ makeSelect
+      {qeSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}])
+    ]
+  where
+    ms = SelectStatement $ makeSelect {qeSelectList = [(NumLit "1",Nothing)]}

tools/Language/SQL/SimpleSQL/QueryExprs.lhs

@@ -1,24 +0,0 @@
-
-These are the tests for the queryExprs parsing which parses multiple
-query expressions from one string.
-
-> module Language.SQL.SimpleSQL.QueryExprs (queryExprsTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-> queryExprsTests :: TestItem
-> queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011))
->     [("select 1",[ms])
->     ,("select 1;",[ms])
->     ,("select 1;select 1",[ms,ms])
->     ,(" select 1;select 1; ",[ms,ms])
->     ,("SELECT CURRENT_TIMESTAMP;"
->      ,[SelectStatement $ makeSelect
->       {qeSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}])
->     ,("SELECT \"CURRENT_TIMESTAMP\";"
->      ,[SelectStatement $ makeSelect
->       {qeSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}])
->     ]
->   where
->     ms = SelectStatement $ makeSelect {qeSelectList = [(NumLit "1",Nothing)]}

tools/Language/SQL/SimpleSQL/SQL2011AccessControl.hs

@@ -0,0 +1,329 @@
+
+{-
+Section 12 in Foundation
+
+grant, etc
+-}
+
+
+module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+sql2011AccessControlTests :: TestItem
+sql2011AccessControlTests = Group "sql 2011 access control tests" [
+
+{-
+12 Access control
+
+12.1 <grant statement>
+
+<grant statement> ::=
+    <grant privilege statement>
+  | <grant role statement>
+
+12.2 <grant privilege statement>
+
+<grant privilege statement> ::=
+  GRANT <privileges> TO <grantee> [ { <comma> <grantee> }... ]
+      [ WITH HIERARCHY OPTION ]
+      [ WITH GRANT OPTION ]
+      [ GRANTED BY <grantor> ]
+
+12.3 <privileges>
+<privileges> ::=
+  <object privileges> ON <object name>
+
+<object name> ::=
+      [ TABLE ] <table name>
+  |   DOMAIN <domain name>
+  |   COLLATION <collation name>
+  |   CHARACTER SET <character set name>
+  |   TRANSLATION <transliteration name>
+  |   TYPE <schema-resolved user-defined type name>
+  |   SEQUENCE <sequence generator name>
+  |   <specific routine designator>
+
+<object privileges> ::=
+    ALL PRIVILEGES
+  | <action> [ { <comma> <action> }... ]
+
+<action> ::=
+    SELECT
+  | SELECT <left paren> <privilege column list> <right paren>
+  | SELECT <left paren> <privilege method list> <right paren>
+  | DELETE
+  | INSERT [ <left paren> <privilege column list> <right paren> ]
+  | UPDATE [ <left paren> <privilege column list> <right paren> ]
+  | REFERENCES [ <left paren> <privilege column list> <right paren> ]
+  | USAGE
+  | TRIGGER
+  | UNDER
+  | EXECUTE
+
+<privilege method list> ::=
+  <specific routine designator> [ { <comma> <specific routine designator> }... ]
+
+<privilege column list> ::=
+  <column name list>
+
+<grantee> ::=
+    PUBLIC
+  | <authorization identifier>
+
+<grantor> ::=
+    CURRENT_USER
+  | CURRENT_ROLE
+-}
+
+     (TestStatement ansi2011
+      "grant all privileges on tbl1 to role1"
+     $ GrantPrivilege [PrivAll]
+       (PrivTable [Name Nothing "tbl1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+
+    ,(TestStatement ansi2011
+      "grant all privileges on tbl1 to role1,role2"
+     $ GrantPrivilege [PrivAll]
+       (PrivTable [Name Nothing "tbl1"])
+       [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant all privileges on tbl1 to role1 with grant option"
+     $ GrantPrivilege [PrivAll]
+       (PrivTable [Name Nothing "tbl1"])
+       [Name Nothing "role1"] WithGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant all privileges on table tbl1 to role1"
+     $ GrantPrivilege [PrivAll]
+       (PrivTable [Name Nothing "tbl1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant all privileges on domain mydom to role1"
+     $ GrantPrivilege [PrivAll]
+       (PrivDomain [Name Nothing "mydom"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant all privileges on type t1 to role1"
+     $ GrantPrivilege [PrivAll]
+       (PrivType [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant all privileges on sequence s1 to role1"
+     $ GrantPrivilege [PrivAll]
+       (PrivSequence [Name Nothing "s1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+
+    ,(TestStatement ansi2011
+      "grant select on table t1 to role1"
+     $ GrantPrivilege [PrivSelect []]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant select(a,b) on table t1 to role1"
+     $ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant delete on table t1 to role1"
+     $ GrantPrivilege [PrivDelete]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant insert on table t1 to role1"
+     $ GrantPrivilege [PrivInsert []]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant insert(a,b) on table t1 to role1"
+     $ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant update on table t1 to role1"
+     $ GrantPrivilege [PrivUpdate []]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant update(a,b) on table t1 to role1"
+     $ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant references on table t1 to role1"
+     $ GrantPrivilege [PrivReferences []]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant references(a,b) on table t1 to role1"
+     $ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant usage on table t1 to role1"
+     $ GrantPrivilege [PrivUsage]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant trigger on table t1 to role1"
+     $ GrantPrivilege [PrivTrigger]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+
+    ,(TestStatement ansi2011
+      "grant execute on specific function f to role1"
+     $ GrantPrivilege [PrivExecute]
+       (PrivFunction [Name Nothing "f"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+    ,(TestStatement ansi2011
+      "grant select,delete on table t1 to role1"
+     $ GrantPrivilege [PrivSelect [], PrivDelete]
+       (PrivTable [Name Nothing "t1"])
+       [Name Nothing "role1"] WithoutGrantOption)
+
+{-
+skipping for now:
+
+what is 'under' action?
+
+collation, character set, translation, member thing, methods
+
+for review
+
+some pretty big things missing in the standard:
+
+schema, database
+
+functions, etc., by argument types since they can be overloaded
+
+
+
+12.4 <role definition>
+
+<role definition> ::=
+  CREATE ROLE <role name> [ WITH ADMIN <grantor> ]
+-}
+
+    ,(TestStatement ansi2011
+      "create role rolee"
+     $ CreateRole (Name Nothing "rolee"))
+
+
+{-
+12.5 <grant role statement>
+
+<grant role statement> ::=
+  GRANT <role granted> [ { <comma> <role granted> }... ]
+      TO <grantee> [ { <comma> <grantee> }... ]
+      [ WITH ADMIN OPTION ]
+      [ GRANTED BY <grantor> ]
+
+<role granted> ::=
+  <role name>
+-}
+
+    ,(TestStatement ansi2011
+      "grant role1 to public"
+     $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)
+
+    ,(TestStatement ansi2011
+      "grant role1,role2 to role3,role4"
+     $ GrantRole [Name Nothing "role1",Name Nothing "role2"]
+                 [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)
+
+    ,(TestStatement ansi2011
+      "grant role1 to role3 with admin option"
+     $ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)
+
+
+{-
+12.6 <drop role statement>
+
+<drop role statement> ::=
+  DROP ROLE <role name>
+-}
+
+    ,(TestStatement ansi2011
+      "drop role rolee"
+     $ DropRole (Name Nothing "rolee"))
+
+
+{-
+12.7 <revoke statement>
+
+<revoke statement> ::=
+    <revoke privilege statement>
+  | <revoke role statement>
+
+<revoke privilege statement> ::=
+  REVOKE [ <revoke option extension> ] <privileges>
+      FROM <grantee> [ { <comma> <grantee> }... ]
+      [ GRANTED BY <grantor> ]
+      <drop behavior>
+
+<revoke option extension> ::=
+    GRANT OPTION FOR
+  | HIERARCHY OPTION FOR
+-}
+
+
+    ,(TestStatement ansi2011
+      "revoke select on t1 from role1"
+     $ RevokePrivilege NoGrantOptionFor [PrivSelect []]
+              (PrivTable [Name Nothing "t1"])
+              [Name Nothing "role1"] DefaultDropBehaviour)
+
+    ,(TestStatement ansi2011
+      "revoke grant option for select on t1 from role1,role2 cascade"
+     $ RevokePrivilege GrantOptionFor [PrivSelect []]
+                       (PrivTable [Name Nothing "t1"])
+              [Name Nothing "role1",Name Nothing "role2"] Cascade)
+
+
+{-
+<revoke role statement> ::=
+  REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]
+      FROM <grantee> [ { <comma> <grantee> }... ]
+      [ GRANTED BY <grantor> ]
+      <drop behavior>
+
+<role revoked> ::=
+  <role name>
+-}
+
+    ,(TestStatement ansi2011
+      "revoke role1 from role2"
+     $ RevokeRole NoAdminOptionFor [Name Nothing "role1"]
+                  [Name Nothing "role2"] DefaultDropBehaviour)
+
+    ,(TestStatement ansi2011
+      "revoke role1,role2 from role3,role4"
+     $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]
+                  [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)
+
+
+    ,(TestStatement ansi2011
+      "revoke admin option for role1 from role2 cascade"
+     $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade)
+
+
+   ]

tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs

@@ -1,315 +0,0 @@
-
-Section 12 in Foundation
-
-grant, etc
-
-
-> module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-> sql2011AccessControlTests :: TestItem
-> sql2011AccessControlTests = Group "sql 2011 access control tests" [
-
-12 Access control
-
-12.1 <grant statement>
-
-<grant statement> ::=
-    <grant privilege statement>
-  | <grant role statement>
-
-12.2 <grant privilege statement>
-
-<grant privilege statement> ::=
-  GRANT <privileges> TO <grantee> [ { <comma> <grantee> }... ]
-      [ WITH HIERARCHY OPTION ]
-      [ WITH GRANT OPTION ]
-      [ GRANTED BY <grantor> ]
-
-12.3 <privileges>
-<privileges> ::=
-  <object privileges> ON <object name>
-
-<object name> ::=
-      [ TABLE ] <table name>
-  |   DOMAIN <domain name>
-  |   COLLATION <collation name>
-  |   CHARACTER SET <character set name>
-  |   TRANSLATION <transliteration name>
-  |   TYPE <schema-resolved user-defined type name>
-  |   SEQUENCE <sequence generator name>
-  |   <specific routine designator>
-
-<object privileges> ::=
-    ALL PRIVILEGES
-  | <action> [ { <comma> <action> }... ]
-
-<action> ::=
-    SELECT
-  | SELECT <left paren> <privilege column list> <right paren>
-  | SELECT <left paren> <privilege method list> <right paren>
-  | DELETE
-  | INSERT [ <left paren> <privilege column list> <right paren> ]
-  | UPDATE [ <left paren> <privilege column list> <right paren> ]
-  | REFERENCES [ <left paren> <privilege column list> <right paren> ]
-  | USAGE
-  | TRIGGER
-  | UNDER
-  | EXECUTE
-
-<privilege method list> ::=
-  <specific routine designator> [ { <comma> <specific routine designator> }... ]
-
-<privilege column list> ::=
-  <column name list>
-
-<grantee> ::=
-    PUBLIC
-  | <authorization identifier>
-
-<grantor> ::=
-    CURRENT_USER
-  | CURRENT_ROLE
-
->      (TestStatement ansi2011
->       "grant all privileges on tbl1 to role1"
->      $ GrantPrivilege [PrivAll]
->        (PrivTable [Name Nothing "tbl1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
-
->     ,(TestStatement ansi2011
->       "grant all privileges on tbl1 to role1,role2"
->      $ GrantPrivilege [PrivAll]
->        (PrivTable [Name Nothing "tbl1"])
->        [Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant all privileges on tbl1 to role1 with grant option"
->      $ GrantPrivilege [PrivAll]
->        (PrivTable [Name Nothing "tbl1"])
->        [Name Nothing "role1"] WithGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant all privileges on table tbl1 to role1"
->      $ GrantPrivilege [PrivAll]
->        (PrivTable [Name Nothing "tbl1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant all privileges on domain mydom to role1"
->      $ GrantPrivilege [PrivAll]
->        (PrivDomain [Name Nothing "mydom"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant all privileges on type t1 to role1"
->      $ GrantPrivilege [PrivAll]
->        (PrivType [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant all privileges on sequence s1 to role1"
->      $ GrantPrivilege [PrivAll]
->        (PrivSequence [Name Nothing "s1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
-
->     ,(TestStatement ansi2011
->       "grant select on table t1 to role1"
->      $ GrantPrivilege [PrivSelect []]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant select(a,b) on table t1 to role1"
->      $ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant delete on table t1 to role1"
->      $ GrantPrivilege [PrivDelete]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant insert on table t1 to role1"
->      $ GrantPrivilege [PrivInsert []]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant insert(a,b) on table t1 to role1"
->      $ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant update on table t1 to role1"
->      $ GrantPrivilege [PrivUpdate []]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant update(a,b) on table t1 to role1"
->      $ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant references on table t1 to role1"
->      $ GrantPrivilege [PrivReferences []]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant references(a,b) on table t1 to role1"
->      $ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant usage on table t1 to role1"
->      $ GrantPrivilege [PrivUsage]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant trigger on table t1 to role1"
->      $ GrantPrivilege [PrivTrigger]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
-
->     ,(TestStatement ansi2011
->       "grant execute on specific function f to role1"
->      $ GrantPrivilege [PrivExecute]
->        (PrivFunction [Name Nothing "f"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
->     ,(TestStatement ansi2011
->       "grant select,delete on table t1 to role1"
->      $ GrantPrivilege [PrivSelect [], PrivDelete]
->        (PrivTable [Name Nothing "t1"])
->        [Name Nothing "role1"] WithoutGrantOption)
-
-skipping for now:
-
-what is 'under' action?
-
-collation, character set, translation, member thing, methods
-
-for review
-
-some pretty big things missing in the standard:
-
-schema, database
-
-functions, etc., by argument types since they can be overloaded
-
-
-
-12.4 <role definition>
-
-<role definition> ::=
-  CREATE ROLE <role name> [ WITH ADMIN <grantor> ]
-
->     ,(TestStatement ansi2011
->       "create role rolee"
->      $ CreateRole (Name Nothing "rolee"))
-
-
-12.5 <grant role statement>
-
-<grant role statement> ::=
-  GRANT <role granted> [ { <comma> <role granted> }... ]
-      TO <grantee> [ { <comma> <grantee> }... ]
-      [ WITH ADMIN OPTION ]
-      [ GRANTED BY <grantor> ]
-
-<role granted> ::=
-  <role name>
-
->     ,(TestStatement ansi2011
->       "grant role1 to public"
->      $ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)
-
->     ,(TestStatement ansi2011
->       "grant role1,role2 to role3,role4"
->      $ GrantRole [Name Nothing "role1",Name Nothing "role2"]
->                  [Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)
-
->     ,(TestStatement ansi2011
->       "grant role1 to role3 with admin option"
->      $ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)
-
-
-12.6 <drop role statement>
-
-<drop role statement> ::=
-  DROP ROLE <role name>
-
->     ,(TestStatement ansi2011
->       "drop role rolee"
->      $ DropRole (Name Nothing "rolee"))
-
-
-12.7 <revoke statement>
-
-<revoke statement> ::=
-    <revoke privilege statement>
-  | <revoke role statement>
-
-<revoke privilege statement> ::=
-  REVOKE [ <revoke option extension> ] <privileges>
-      FROM <grantee> [ { <comma> <grantee> }... ]
-      [ GRANTED BY <grantor> ]
-      <drop behavior>
-
-<revoke option extension> ::=
-    GRANT OPTION FOR
-  | HIERARCHY OPTION FOR
-
-
->     ,(TestStatement ansi2011
->       "revoke select on t1 from role1"
->      $ RevokePrivilege NoGrantOptionFor [PrivSelect []]
->               (PrivTable [Name Nothing "t1"])
->               [Name Nothing "role1"] DefaultDropBehaviour)
-
->     ,(TestStatement ansi2011
->       "revoke grant option for select on t1 from role1,role2 cascade"
->      $ RevokePrivilege GrantOptionFor [PrivSelect []]
->                        (PrivTable [Name Nothing "t1"])
->               [Name Nothing "role1",Name Nothing "role2"] Cascade)
-
-
-<revoke role statement> ::=
-  REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]
-      FROM <grantee> [ { <comma> <grantee> }... ]
-      [ GRANTED BY <grantor> ]
-      <drop behavior>
-
-<role revoked> ::=
-  <role name>
-
->     ,(TestStatement ansi2011
->       "revoke role1 from role2"
->      $ RevokeRole NoAdminOptionFor [Name Nothing "role1"]
->                   [Name Nothing "role2"] DefaultDropBehaviour)
-
->     ,(TestStatement ansi2011
->       "revoke role1,role2 from role3,role4"
->      $ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]
->                   [Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)
-
-
->     ,(TestStatement ansi2011
->       "revoke admin option for role1 from role2 cascade"
->      $ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade)
-
-
->    ]

tools/Language/SQL/SimpleSQL/SQL2011Bits.hs

@@ -1,18 +1,21 @@
 
+{-
 Sections 17 and 19 in Foundation
 
 This module covers the tests for transaction management (begin,
 commit, savepoint, etc.), and session management (set).
+-}
 
 
-> module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where
+module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where
 
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
 
-> sql2011BitsTests :: TestItem
-> sql2011BitsTests = Group "sql 2011 bits tests" [
+sql2011BitsTests :: TestItem
+sql2011BitsTests = Group "sql 2011 bits tests" [
 
+{-
 17 Transaction management
 
 17.1 <start transaction statement>
@@ -21,11 +24,13 @@ commit, savepoint, etc.), and session management (set).
   START TRANSACTION [ <transaction characteristics> ]
 
 BEGIN is not in the standard!
+-}
 
->      (TestStatement ansi2011
->       "start transaction"
->      $ StartTransaction)
+     (TestStatement ansi2011
+      "start transaction"
+     $ StartTransaction)
 
+{-
 17.2 <set transaction statement>
 
 <set transaction statement> ::=
@@ -76,36 +81,42 @@ BEGIN is not in the standard!
 
 <savepoint specifier> ::=
   <savepoint name>
+-}
 
->     ,(TestStatement ansi2011
->       "savepoint difficult_bit"
->      $ Savepoint $ Name Nothing "difficult_bit")
+    ,(TestStatement ansi2011
+      "savepoint difficult_bit"
+     $ Savepoint $ Name Nothing "difficult_bit")
 
 
+{-
 17.6 <release savepoint statement>
 
 <release savepoint statement> ::=
   RELEASE SAVEPOINT <savepoint specifier>
+-}
 
->     ,(TestStatement ansi2011
->       "release savepoint difficult_bit"
->      $ ReleaseSavepoint $ Name Nothing "difficult_bit")
+    ,(TestStatement ansi2011
+      "release savepoint difficult_bit"
+     $ ReleaseSavepoint $ Name Nothing "difficult_bit")
 
 
+{-
 17.7 <commit statement>
 
 <commit statement> ::=
   COMMIT [ WORK ] [ AND [ NO ] CHAIN ]
+-}
 
->     ,(TestStatement ansi2011
->       "commit"
->      $ Commit)
+    ,(TestStatement ansi2011
+      "commit"
+     $ Commit)
 
->     ,(TestStatement ansi2011
->       "commit work"
->      $ Commit)
+    ,(TestStatement ansi2011
+      "commit work"
+     $ Commit)
 
 
+{-
 17.8 <rollback statement>
 
 <rollback statement> ::=
@@ -113,20 +124,22 @@ BEGIN is not in the standard!
 
 <savepoint clause> ::=
   TO SAVEPOINT <savepoint specifier>
+-}
 
->     ,(TestStatement ansi2011
->       "rollback"
->      $ Rollback Nothing)
+    ,(TestStatement ansi2011
+      "rollback"
+     $ Rollback Nothing)
 
->     ,(TestStatement ansi2011
->       "rollback work"
->      $ Rollback Nothing)
+    ,(TestStatement ansi2011
+      "rollback work"
+     $ Rollback Nothing)
 
->     ,(TestStatement ansi2011
->       "rollback to savepoint difficult_bit"
->      $ Rollback $ Just $ Name Nothing "difficult_bit")
+    ,(TestStatement ansi2011
+      "rollback to savepoint difficult_bit"
+     $ Rollback $ Just $ Name Nothing "difficult_bit")
 
 
+{-
 19 Session management
 
 19.1 <set session characteristics statement>
@@ -215,5 +228,6 @@ BEGIN is not in the standard!
 
 <collation specification> ::=
   <value specification>
+-}
 
->    ]
+   ]

tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs

@@ -1,17 +1,18 @@
 
-Section 14 in Foundation
+-- Section 14 in Foundation
 
 
-> module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where
+module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where
 
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
 
-> sql2011DataManipulationTests :: TestItem
-> sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
->     [
+sql2011DataManipulationTests :: TestItem
+sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
+    [
 
 
+{-
 14 Data manipulation
 
 
@@ -107,22 +108,24 @@ Section 14 in Foundation
         FROM <point in time 1> TO <point in time 2> ]
       [ [ AS ] <correlation name> ]
       [ WHERE <search condition> ]
+-}
 
->      (TestStatement ansi2011 "delete from t"
->      $ Delete [Name Nothing "t"] Nothing Nothing)
+     (TestStatement ansi2011 "delete from t"
+     $ Delete [Name Nothing "t"] Nothing Nothing)
 
->     ,(TestStatement ansi2011 "delete from t as u"
->      $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing)
+    ,(TestStatement ansi2011 "delete from t as u"
+     $ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing)
 
->     ,(TestStatement ansi2011 "delete from t where x = 5"
->      $ Delete [Name Nothing "t"] Nothing
->        (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
+    ,(TestStatement ansi2011 "delete from t where x = 5"
+     $ Delete [Name Nothing "t"] Nothing
+       (Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
 
 
->     ,(TestStatement ansi2011 "delete from t as u where u.x = 5"
->      $ Delete [Name Nothing "t"] (Just (Name Nothing "u"))
->        (Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
+    ,(TestStatement ansi2011 "delete from t as u where u.x = 5"
+     $ Delete [Name Nothing "t"] (Just (Name Nothing "u"))
+       (Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
 
+{-
 14.10 <truncate table statement>
 
 <truncate table statement> ::=
@@ -131,17 +134,19 @@ Section 14 in Foundation
 <identity column restart option> ::=
     CONTINUE IDENTITY
   | RESTART IDENTITY
+-}
 
->     ,(TestStatement ansi2011 "truncate table t"
->      $ Truncate [Name Nothing "t"] DefaultIdentityRestart)
+    ,(TestStatement ansi2011 "truncate table t"
+     $ Truncate [Name Nothing "t"] DefaultIdentityRestart)
 
->     ,(TestStatement ansi2011 "truncate table t continue identity"
->      $ Truncate [Name Nothing "t"] ContinueIdentity)
+    ,(TestStatement ansi2011 "truncate table t continue identity"
+     $ Truncate [Name Nothing "t"] ContinueIdentity)
 
->     ,(TestStatement ansi2011 "truncate table t restart identity"
->      $ Truncate [Name Nothing "t"] RestartIdentity)
+    ,(TestStatement ansi2011 "truncate table t restart identity"
+     $ Truncate [Name Nothing "t"] RestartIdentity)
 
 
+{-
 14.11 <insert statement>
 
 <insert statement> ::=
@@ -174,40 +179,42 @@ Section 14 in Foundation
 
 <insert column list> ::=
   <column name list>
+-}
 
->     ,(TestStatement ansi2011 "insert into t select * from u"
->      $ Insert [Name Nothing "t"] Nothing
->        $ InsertQuery makeSelect
->          {qeSelectList = [(Star, Nothing)]
->          ,qeFrom = [TRSimple [Name Nothing "u"]]})
+    ,(TestStatement ansi2011 "insert into t select * from u"
+     $ Insert [Name Nothing "t"] Nothing
+       $ InsertQuery makeSelect
+         {qeSelectList = [(Star, Nothing)]
+         ,qeFrom = [TRSimple [Name Nothing "u"]]})
 
->     ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"
->      $ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"])
->        $ InsertQuery makeSelect
->          {qeSelectList = [(Star, Nothing)]
->          ,qeFrom = [TRSimple [Name Nothing "u"]]})
+    ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"
+     $ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"])
+       $ InsertQuery makeSelect
+         {qeSelectList = [(Star, Nothing)]
+         ,qeFrom = [TRSimple [Name Nothing "u"]]})
 
->     ,(TestStatement ansi2011 "insert into t default values"
->      $ Insert [Name Nothing "t"] Nothing DefaultInsertValues)
+    ,(TestStatement ansi2011 "insert into t default values"
+     $ Insert [Name Nothing "t"] Nothing DefaultInsertValues)
 
->     ,(TestStatement ansi2011 "insert into t values(1,2)"
->      $ Insert [Name Nothing "t"] Nothing
->        $ InsertQuery $ Values [[NumLit "1", NumLit "2"]])
+    ,(TestStatement ansi2011 "insert into t values(1,2)"
+     $ Insert [Name Nothing "t"] Nothing
+       $ InsertQuery $ Values [[NumLit "1", NumLit "2"]])
 
->     ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"
->      $ Insert [Name Nothing "t"] Nothing
->        $ InsertQuery $ Values [[NumLit "1", NumLit "2"]
->                               ,[NumLit "3", NumLit "4"]])
+    ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"
+     $ Insert [Name Nothing "t"] Nothing
+       $ InsertQuery $ Values [[NumLit "1", NumLit "2"]
+                              ,[NumLit "3", NumLit "4"]])
 
->     ,(TestStatement ansi2011
->       "insert into t values (default,null,array[],multiset[])"
->      $ Insert [Name Nothing "t"] Nothing
->        $ InsertQuery $ Values [[Iden [Name Nothing "default"]
->                                ,Iden [Name Nothing "null"]
->                                ,Array (Iden [Name Nothing "array"]) []
->                                ,MultisetCtor []]])
+    ,(TestStatement ansi2011
+      "insert into t values (default,null,array[],multiset[])"
+     $ Insert [Name Nothing "t"] Nothing
+       $ InsertQuery $ Values [[Iden [Name Nothing "default"]
+                               ,Iden [Name Nothing "null"]
+                               ,Array (Iden [Name Nothing "array"]) []
+                               ,MultisetCtor []]])
 
 
+{-
 14.12 <merge statement>
 
 <merge statement> ::=
@@ -445,37 +452,39 @@ FROM CentralOfficeAccounts;
       [ [ AS ] <correlation name> ]
       SET <set clause list>
       [ WHERE <search condition> ]
+-}
 
 
->     ,(TestStatement ansi2011 "update t set a=b"
->      $ Update [Name Nothing "t"] Nothing
->        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)
+    ,(TestStatement ansi2011 "update t set a=b"
+     $ Update [Name Nothing "t"] Nothing
+       [Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)
 
->     ,(TestStatement ansi2011 "update t set a=b, c=5"
->      $ Update [Name Nothing "t"] Nothing
->        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])
->        ,Set [Name Nothing "c"] (NumLit "5")] Nothing)
+    ,(TestStatement ansi2011 "update t set a=b, c=5"
+     $ Update [Name Nothing "t"] Nothing
+       [Set [Name Nothing "a"] (Iden [Name Nothing "b"])
+       ,Set [Name Nothing "c"] (NumLit "5")] Nothing)
 
 
->     ,(TestStatement ansi2011 "update t set a=b where a>5"
->      $ Update [Name Nothing "t"] Nothing
->        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]
->        $ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))
+    ,(TestStatement ansi2011 "update t set a=b where a>5"
+     $ Update [Name Nothing "t"] Nothing
+       [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]
+       $ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))
 
 
->     ,(TestStatement ansi2011 "update t as u set a=b where u.a>5"
->      $ Update [Name Nothing "t"] (Just $ Name Nothing "u")
->        [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]
->        $ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"])
->                       [Name Nothing ">"] (NumLit "5"))
+    ,(TestStatement ansi2011 "update t as u set a=b where u.a>5"
+     $ Update [Name Nothing "t"] (Just $ Name Nothing "u")
+       [Set [Name Nothing "a"] (Iden [Name Nothing "b"])]
+       $ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"])
+                      [Name Nothing ">"] (NumLit "5"))
 
->     ,(TestStatement ansi2011 "update t set (a,b)=(3,5)"
->      $ Update [Name Nothing "t"] Nothing
->        [SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]
->                     [NumLit "3", NumLit "5"]] Nothing)
+    ,(TestStatement ansi2011 "update t set (a,b)=(3,5)"
+     $ Update [Name Nothing "t"] Nothing
+       [SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]
+                    [NumLit "3", NumLit "5"]] Nothing)
 
 
 
+{-
 14.15 <set clause list>
 
 <set clause list> ::=
@@ -539,6 +548,7 @@ declare local temporary table t (a int) [on commit {preserve | delete} rows]
 
 <hold locator statement> ::=
   HOLD LOCATOR <locator reference> [ { <comma> <locator reference> }... ]
+-}
 
 
->    ]
+   ]

tools/Language/SQL/SimpleSQL/ScalarExprs.hs

@@ -0,0 +1,432 @@
+
+-- Tests for parsing scalar expressions
+
+module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+scalarExprTests :: TestItem
+scalarExprTests = Group "scalarExprTests"
+    [literals
+    ,identifiers
+    ,star
+    ,parameter
+    ,dots
+    ,app
+    ,caseexp
+    ,convertfun     
+    ,operators
+    ,parens
+    ,subqueries
+    ,aggregates
+    ,windowFunctions
+    ,functionsWithReservedNames
+    ]
+
+literals :: TestItem
+literals = Group "literals" $ map (uncurry (TestScalarExpr ansi2011))
+    [("3", NumLit "3")
+     ,("3.", NumLit "3.")
+     ,("3.3", NumLit "3.3")
+     ,(".3", NumLit ".3")
+     ,("3.e3", NumLit "3.e3")
+     ,("3.3e3", NumLit "3.3e3")
+     ,(".3e3", NumLit ".3e3")
+     ,("3e3", NumLit "3e3")
+     ,("3e+3", NumLit "3e+3")
+     ,("3e-3", NumLit "3e-3")
+     ,("'string'", StringLit "'" "'" "string")
+     ,("'string with a '' quote'", StringLit "'" "'" "string with a '' quote")
+     ,("'1'", StringLit "'" "'" "1")
+     ,("interval '3' day"
+      ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)
+     ,("interval '3' day (3)"
+      ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing)
+     ,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks")
+    ]
+
+identifiers :: TestItem
+identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))
+    [("iden1", Iden [Name Nothing "iden1"])
+    --,("t.a", Iden2 "t" "a")
+    ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])
+    ,("\"from\"", Iden [Name (Just ("\"","\"")) "from"])
+    ]
+
+star :: TestItem
+star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))
+    [("*", Star)
+    --,("t.*", Star2 "t")
+    --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
+    ]
+
+parameter :: TestItem
+parameter = Group "parameter"
+    [TestScalarExpr ansi2011 "?" Parameter
+    ,TestScalarExpr postgres "$13" $ PositionalArg 13]
+
+
+dots :: TestItem
+dots = Group "dot" $ map (uncurry (TestScalarExpr ansi2011))
+    [("t.a", Iden [Name Nothing "t",Name Nothing "a"])
+    ,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star)
+    ,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"])
+    ,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"])
+    ]
+
+app :: TestItem
+app = Group "app" $ map (uncurry (TestScalarExpr ansi2011))
+    [("f()", App [Name Nothing "f"] [])
+    ,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]])
+    ,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])
+    ]
+
+caseexp :: TestItem
+caseexp = Group "caseexp" $ map (uncurry (TestScalarExpr ansi2011))
+    [("case a when 1 then 2 end"
+     ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]
+                              ,NumLit "2")] Nothing)
+
+    ,("case a when 1 then 2 when 3 then 4 end"
+     ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")
+                             ,([NumLit "3"], NumLit "4")] Nothing)
+
+    ,("case a when 1 then 2 when 3 then 4 else 5 end"
+     ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")
+                             ,([NumLit "3"], NumLit "4")]
+                             (Just $ NumLit "5"))
+
+    ,("case when a=1 then 2 when a=3 then 4 else 5 end"
+     ,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2")
+                   ,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")]
+                   (Just $ NumLit "5"))
+
+    ,("case a when 1,2 then 10 when 3,4 then 20 end"
+     ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"]
+                               ,NumLit "10")
+                             ,([NumLit "3",NumLit "4"]
+                               ,NumLit "20")]
+                             Nothing)
+
+    ]
+
+convertfun :: TestItem 
+convertfun = Group "convert" $ map (uncurry (TestScalarExpr sqlserver))
+    [("CONVERT(varchar, 25.65)"
+     ,Convert (TypeName [Name Nothing "varchar"]) (NumLit "25.65") Nothing)
+    ,("CONVERT(datetime, '2017-08-25')"
+     ,Convert (TypeName [Name Nothing "datetime"]) (StringLit "'" "'" "2017-08-25") Nothing)
+    ,("CONVERT(varchar, '2017-08-25', 101)"
+     ,Convert (TypeName [Name Nothing "varchar"]) (StringLit "'" "'" "2017-08-25") (Just 101))
+    ]
+
+operators :: TestItem
+operators = Group "operators"
+    [binaryOperators
+    ,unaryOperators
+    ,casts
+    ,miscOps]
+
+binaryOperators :: TestItem
+binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
+    [("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))
+     -- sanity check fixities
+     -- todo: add more fixity checking
+
+    ,("a + b * c"
+     ,BinOp  (Iden [Name Nothing "a"]) [Name Nothing "+"]
+             (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])))
+
+    ,("a * b + c"
+     ,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"]))
+            [Name Nothing "+"] (Iden [Name Nothing "c"]))
+    ]
+
+unaryOperators :: TestItem
+unaryOperators = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
+    [("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])
+    ,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])
+    ,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"])
+    ,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"])
+    ]
+
+
+casts :: TestItem
+casts = Group "operators" $ map (uncurry (TestScalarExpr ansi2011))
+    [("cast('1' as int)"
+     ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"])
+
+    ,("int '3'"
+     ,TypedLit (TypeName [Name Nothing "int"]) "3")
+
+    ,("cast('1' as double precision)"
+     ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])
+
+    ,("cast('1' as float(8))"
+     ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8)
+
+    ,("cast('1' as decimal(15,2))"
+     ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2)
+
+
+    ,("double precision '3'"
+     ,TypedLit (TypeName [Name Nothing "double precision"]) "3")
+    ]
+
+subqueries :: TestItem
+subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
+    [("exists (select a from t)", SubQueryExpr SqExists ms)
+    ,("(select a from t)", SubQueryExpr SqSq ms)
+
+    ,("a in (select a from t)"
+     ,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))
+
+    ,("a not in (select a from t)"
+     ,In False (Iden [Name Nothing "a"]) (InQueryExpr ms))
+
+    ,("a > all (select a from t)"
+     ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)
+
+    ,("a = some (select a from t)"
+     ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms)
+
+    ,("a <= any (select a from t)"
+     ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms)
+    ]
+  where
+    ms = makeSelect
+         {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+         ,qeFrom = [TRSimple [Name Nothing "t"]]
+         }
+
+miscOps :: TestItem
+miscOps = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
+    [("a in (1,2,3)"
+     ,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"])
+
+    ,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"]))
+    ,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"]))
+    ,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"]))
+    ,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"]))
+    ,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"]))
+    ,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"]))
+    ,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"]))
+    ,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"]))
+    ,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"]))
+
+    ,("a is not distinct from b"
+     ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"]))
+
+    ,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"]))
+    ,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"]))
+    ,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"]))
+
+    ,("a is not similar to b"
+     ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"]))
+
+    ,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"]))
+
+
+-- special operators
+
+    ,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]
+                                               ,Iden [Name Nothing "b"]
+                                               ,Iden [Name Nothing "c"]])
+
+    ,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]
+                                                       ,Iden [Name Nothing "b"]
+                                                       ,Iden [Name Nothing "c"]])
+    ,("(1,2)"
+     ,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"])
+
+
+-- keyword special operators
+
+    ,("extract(day from t)"
+     , SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
+
+    ,("substring(x from 1 for 2)"
+     ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")
+                                               ,("for", NumLit "2")])
+
+    ,("substring(x from 1)"
+     ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")])
+
+    ,("substring(x for 2)"
+     ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")])
+
+    ,("substring(x from 1 for 2 collate C)"
+     ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"])
+          [("from", NumLit "1")
+          ,("for", Collate (NumLit "2") [Name Nothing "C"])])
+
+-- this doesn't work because of a overlap in the 'in' parser
+
+    ,("POSITION( string1 IN string2 )"
+     ,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])])
+
+    ,("CONVERT(char_value USING conversion_char_name)"
+     ,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])
+          [("using", Iden [Name Nothing "conversion_char_name"])])
+
+    ,("TRANSLATE(char_value USING translation_name)"
+     ,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"])
+          [("using", Iden [Name Nothing "translation_name"])])
+
+{-
+OVERLAY(string PLACING embedded_string FROM start
+[FOR length])
+-}
+
+    ,("OVERLAY(string PLACING embedded_string FROM start)"
+     ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
+          [("placing", Iden [Name Nothing "embedded_string"])
+          ,("from", Iden [Name Nothing "start"])])
+
+    ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"
+     ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
+          [("placing", Iden [Name Nothing "embedded_string"])
+          ,("from", Iden [Name Nothing "start"])
+          ,("for", Iden [Name Nothing "length"])])
+
+{-
+TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
+target_string
+[COLLATE collation_name] )
+-}
+
+
+
+    ,("trim(from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("both", StringLit "'" "'" " ")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+    ,("trim(leading from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("leading", StringLit "'" "'" " ")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+    ,("trim(trailing from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("trailing", StringLit "'" "'" " ")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+    ,("trim(both from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("both", StringLit "'" "'" " ")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+
+    ,("trim(leading 'x' from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("leading", StringLit "'" "'" "x")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+    ,("trim(trailing 'y' from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("trailing", StringLit "'" "'" "y")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+    ,("trim(both 'z' from target_string collate C)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("both", StringLit "'" "'" "z")
+          ,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])])
+
+    ,("trim(leading from target_string)"
+     ,SpecialOpK [Name Nothing "trim"] Nothing
+          [("leading", StringLit "'" "'" " ")
+          ,("from", Iden [Name Nothing "target_string"])])
+
+
+    ]
+
+aggregates :: TestItem
+aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))
+    [("count(*)",App [Name Nothing "count"] [Star])
+
+    ,("sum(a order by a)"
+    ,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]
+                  [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing)
+
+    ,("sum(all a)"
+    ,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing)
+
+    ,("count(distinct a)"
+    ,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing)
+    ]
+
+windowFunctions :: TestItem
+windowFunctions = Group "windowFunctions" $ map (uncurry (TestScalarExpr ansi2011))
+    [("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing)
+    ,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing)
+
+    ,("max(a) over (partition by b)"
+     ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing)
+
+    ,("max(a) over (partition by b,c)"
+     ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing)
+
+    ,("sum(a) over (order by b)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []
+          [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing)
+
+    ,("sum(a) over (order by b desc,c)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []
+          [SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault
+          ,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)
+
+    ,("sum(a) over (partition by b order by c)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+          [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)
+
+    ,("sum(a) over (partition by b order by c range unbounded preceding)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+      [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
+      $ Just $ FrameFrom FrameRange UnboundedPreceding)
+
+    ,("sum(a) over (partition by b order by c range 5 preceding)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+      [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
+      $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))
+
+    ,("sum(a) over (partition by b order by c range current row)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+      [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
+      $ Just $ FrameFrom FrameRange Current)
+
+    ,("sum(a) over (partition by b order by c rows 5 following)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+      [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
+      $ Just $ FrameFrom FrameRows $ Following (NumLit "5"))
+
+    ,("sum(a) over (partition by b order by c range unbounded following)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+      [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
+      $ Just $ FrameFrom FrameRange UnboundedFollowing)
+
+    ,("sum(a) over (partition by b order by c \n\
+      \range between 5 preceding and 5 following)"
+     ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
+      [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
+      $ Just $ FrameBetween FrameRange
+                            (Preceding (NumLit "5"))
+                            (Following (NumLit "5")))
+
+    ]
+
+parens :: TestItem
+parens = Group "parens" $ map (uncurry (TestScalarExpr ansi2011))
+    [("(a)", Parens (Iden [Name Nothing "a"]))
+    ,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])))
+    ]
+
+functionsWithReservedNames :: TestItem
+functionsWithReservedNames = Group "functionsWithReservedNames" $ map t
+    ["abs"
+    ,"char_length"
+    ]
+  where
+    t fn = TestScalarExpr ansi2011 (fn ++ "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]
+

tools/Language/SQL/SimpleSQL/ScalarExprs.lhs

@@ -1,428 +0,0 @@
-
-Tests for parsing scalar expressions
-
-> module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-> scalarExprTests :: TestItem
-> scalarExprTests = Group "scalarExprTests"
->     [literals
->     ,identifiers
->     ,star
->     ,parameter
->     ,dots
->     ,app
->     ,caseexp
->     ,convertfun     
->     ,operators
->     ,parens
->     ,subqueries
->     ,aggregates
->     ,windowFunctions
->     ,functionsWithReservedNames
->     ]
-
-> literals :: TestItem
-> literals = Group "literals" $ map (uncurry (TestScalarExpr ansi2011))
->     [("3", NumLit "3")
->      ,("3.", NumLit "3.")
->      ,("3.3", NumLit "3.3")
->      ,(".3", NumLit ".3")
->      ,("3.e3", NumLit "3.e3")
->      ,("3.3e3", NumLit "3.3e3")
->      ,(".3e3", NumLit ".3e3")
->      ,("3e3", NumLit "3e3")
->      ,("3e+3", NumLit "3e+3")
->      ,("3e-3", NumLit "3e-3")
->      ,("'string'", StringLit "'" "'" "string")
->      ,("'string with a '' quote'", StringLit "'" "'" "string with a '' quote")
->      ,("'1'", StringLit "'" "'" "1")
->      ,("interval '3' day"
->       ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)
->      ,("interval '3' day (3)"
->       ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing)
->      ,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks")
->     ]
-
-> identifiers :: TestItem
-> identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))
->     [("iden1", Iden [Name Nothing "iden1"])
->     --,("t.a", Iden2 "t" "a")
->     ,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])
->     ,("\"from\"", Iden [Name (Just ("\"","\"")) "from"])
->     ]
-
-> star :: TestItem
-> star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))
->     [("*", Star)
->     --,("t.*", Star2 "t")
->     --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
->     ]
-
-> parameter :: TestItem
-> parameter = Group "parameter"
->     [TestScalarExpr ansi2011 "?" Parameter
->     ,TestScalarExpr postgres "$13" $ PositionalArg 13]
-
-
-> dots :: TestItem
-> dots = Group "dot" $ map (uncurry (TestScalarExpr ansi2011))
->     [("t.a", Iden [Name Nothing "t",Name Nothing "a"])
->     ,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star)
->     ,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"])
->     ,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"])
->     ]
-
-> app :: TestItem
-> app = Group "app" $ map (uncurry (TestScalarExpr ansi2011))
->     [("f()", App [Name Nothing "f"] [])
->     ,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]])
->     ,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])
->     ]
-
-> caseexp :: TestItem
-> caseexp = Group "caseexp" $ map (uncurry (TestScalarExpr ansi2011))
->     [("case a when 1 then 2 end"
->      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]
->                               ,NumLit "2")] Nothing)
-
->     ,("case a when 1 then 2 when 3 then 4 end"
->      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")
->                              ,([NumLit "3"], NumLit "4")] Nothing)
-
->     ,("case a when 1 then 2 when 3 then 4 else 5 end"
->      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")
->                              ,([NumLit "3"], NumLit "4")]
->                              (Just $ NumLit "5"))
-
->     ,("case when a=1 then 2 when a=3 then 4 else 5 end"
->      ,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2")
->                    ,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")]
->                    (Just $ NumLit "5"))
-
->     ,("case a when 1,2 then 10 when 3,4 then 20 end"
->      ,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"]
->                                ,NumLit "10")
->                              ,([NumLit "3",NumLit "4"]
->                                ,NumLit "20")]
->                              Nothing)
-
->     ]
-
-> convertfun :: TestItem 
-> convertfun = Group "convert" $ map (uncurry (TestScalarExpr sqlserver))
->     [("CONVERT(varchar, 25.65)"
->      ,Convert (TypeName [Name Nothing "varchar"]) (NumLit "25.65") Nothing)
->     ,("CONVERT(datetime, '2017-08-25')"
->      ,Convert (TypeName [Name Nothing "datetime"]) (StringLit "'" "'" "2017-08-25") Nothing)
->     ,("CONVERT(varchar, '2017-08-25', 101)"
->      ,Convert (TypeName [Name Nothing "varchar"]) (StringLit "'" "'" "2017-08-25") (Just 101))
->     ]
-
-> operators :: TestItem
-> operators = Group "operators"
->     [binaryOperators
->     ,unaryOperators
->     ,casts
->     ,miscOps]
-
-> binaryOperators :: TestItem
-> binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
->     [("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))
->      -- sanity check fixities
->      -- todo: add more fixity checking
-
->     ,("a + b * c"
->      ,BinOp  (Iden [Name Nothing "a"]) [Name Nothing "+"]
->              (BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])))
-
->     ,("a * b + c"
->      ,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"]))
->             [Name Nothing "+"] (Iden [Name Nothing "c"]))
->     ]
-
-> unaryOperators :: TestItem
-> unaryOperators = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
->     [("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])
->     ,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])
->     ,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"])
->     ,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"])
->     ]
-
-
-> casts :: TestItem
-> casts = Group "operators" $ map (uncurry (TestScalarExpr ansi2011))
->     [("cast('1' as int)"
->      ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"])
-
->     ,("int '3'"
->      ,TypedLit (TypeName [Name Nothing "int"]) "3")
-
->     ,("cast('1' as double precision)"
->      ,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])
-
->     ,("cast('1' as float(8))"
->      ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8)
-
->     ,("cast('1' as decimal(15,2))"
->      ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2)
-
-
->     ,("double precision '3'"
->      ,TypedLit (TypeName [Name Nothing "double precision"]) "3")
->     ]
-
-> subqueries :: TestItem
-> subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
->     [("exists (select a from t)", SubQueryExpr SqExists ms)
->     ,("(select a from t)", SubQueryExpr SqSq ms)
-
->     ,("a in (select a from t)"
->      ,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))
-
->     ,("a not in (select a from t)"
->      ,In False (Iden [Name Nothing "a"]) (InQueryExpr ms))
-
->     ,("a > all (select a from t)"
->      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)
-
->     ,("a = some (select a from t)"
->      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms)
-
->     ,("a <= any (select a from t)"
->      ,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms)
->     ]
->   where
->     ms = makeSelect
->          {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->          ,qeFrom = [TRSimple [Name Nothing "t"]]
->          }
-
-> miscOps :: TestItem
-> miscOps = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
->     [("a in (1,2,3)"
->      ,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"])
-
->     ,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"]))
->     ,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"]))
->     ,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"]))
->     ,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"]))
->     ,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"]))
->     ,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"]))
->     ,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"]))
->     ,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"]))
->     ,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"]))
-
->     ,("a is not distinct from b"
->      ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"]))
-
->     ,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"]))
->     ,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"]))
->     ,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"]))
-
->     ,("a is not similar to b"
->      ,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"]))
-
->     ,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"]))
-
-
-special operators
-
->     ,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]
->                                                ,Iden [Name Nothing "b"]
->                                                ,Iden [Name Nothing "c"]])
-
->     ,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]
->                                                        ,Iden [Name Nothing "b"]
->                                                        ,Iden [Name Nothing "c"]])
->     ,("(1,2)"
->      ,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"])
-
-
-keyword special operators
-
->     ,("extract(day from t)"
->      , SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
-
->     ,("substring(x from 1 for 2)"
->      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")
->                                                ,("for", NumLit "2")])
-
->     ,("substring(x from 1)"
->      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")])
-
->     ,("substring(x for 2)"
->      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")])
-
->     ,("substring(x from 1 for 2 collate C)"
->      ,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"])
->           [("from", NumLit "1")
->           ,("for", Collate (NumLit "2") [Name Nothing "C"])])
-
-this doesn't work because of a overlap in the 'in' parser
-
->     ,("POSITION( string1 IN string2 )"
->      ,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])])
-
->     ,("CONVERT(char_value USING conversion_char_name)"
->      ,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])
->           [("using", Iden [Name Nothing "conversion_char_name"])])
-
->     ,("TRANSLATE(char_value USING translation_name)"
->      ,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"])
->           [("using", Iden [Name Nothing "translation_name"])])
-
-OVERLAY(string PLACING embedded_string FROM start
-[FOR length])
-
->     ,("OVERLAY(string PLACING embedded_string FROM start)"
->      ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
->           [("placing", Iden [Name Nothing "embedded_string"])
->           ,("from", Iden [Name Nothing "start"])])
-
->     ,("OVERLAY(string PLACING embedded_string FROM start FOR length)"
->      ,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
->           [("placing", Iden [Name Nothing "embedded_string"])
->           ,("from", Iden [Name Nothing "start"])
->           ,("for", Iden [Name Nothing "length"])])
-
-TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
-target_string
-[COLLATE collation_name] )
-
-
-
->     ,("trim(from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("both", StringLit "'" "'" " ")
->           ,("from", Iden [Name Nothing "target_string"])])
-
->     ,("trim(leading from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("leading", StringLit "'" "'" " ")
->           ,("from", Iden [Name Nothing "target_string"])])
-
->     ,("trim(trailing from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("trailing", StringLit "'" "'" " ")
->           ,("from", Iden [Name Nothing "target_string"])])
-
->     ,("trim(both from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("both", StringLit "'" "'" " ")
->           ,("from", Iden [Name Nothing "target_string"])])
-
-
->     ,("trim(leading 'x' from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("leading", StringLit "'" "'" "x")
->           ,("from", Iden [Name Nothing "target_string"])])
-
->     ,("trim(trailing 'y' from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("trailing", StringLit "'" "'" "y")
->           ,("from", Iden [Name Nothing "target_string"])])
-
->     ,("trim(both 'z' from target_string collate C)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("both", StringLit "'" "'" "z")
->           ,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])])
-
->     ,("trim(leading from target_string)"
->      ,SpecialOpK [Name Nothing "trim"] Nothing
->           [("leading", StringLit "'" "'" " ")
->           ,("from", Iden [Name Nothing "target_string"])])
-
-
->     ]
-
-> aggregates :: TestItem
-> aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))
->     [("count(*)",App [Name Nothing "count"] [Star])
-
->     ,("sum(a order by a)"
->     ,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]
->                   [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing)
-
->     ,("sum(all a)"
->     ,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing)
-
->     ,("count(distinct a)"
->     ,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing)
->     ]
-
-> windowFunctions :: TestItem
-> windowFunctions = Group "windowFunctions" $ map (uncurry (TestScalarExpr ansi2011))
->     [("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing)
->     ,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing)
-
->     ,("max(a) over (partition by b)"
->      ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing)
-
->     ,("max(a) over (partition by b,c)"
->      ,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing)
-
->     ,("sum(a) over (order by b)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []
->           [SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing)
-
->     ,("sum(a) over (order by b desc,c)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []
->           [SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault
->           ,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)
-
->     ,("sum(a) over (partition by b order by c)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->           [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)
-
->     ,("sum(a) over (partition by b order by c range unbounded preceding)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
->       $ Just $ FrameFrom FrameRange UnboundedPreceding)
-
->     ,("sum(a) over (partition by b order by c range 5 preceding)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
->       $ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))
-
->     ,("sum(a) over (partition by b order by c range current row)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
->       $ Just $ FrameFrom FrameRange Current)
-
->     ,("sum(a) over (partition by b order by c rows 5 following)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
->       $ Just $ FrameFrom FrameRows $ Following (NumLit "5"))
-
->     ,("sum(a) over (partition by b order by c range unbounded following)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
->       $ Just $ FrameFrom FrameRange UnboundedFollowing)
-
->     ,("sum(a) over (partition by b order by c \n\
->       \range between 5 preceding and 5 following)"
->      ,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
->       [SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
->       $ Just $ FrameBetween FrameRange
->                             (Preceding (NumLit "5"))
->                             (Following (NumLit "5")))
-
->     ]
-
-> parens :: TestItem
-> parens = Group "parens" $ map (uncurry (TestScalarExpr ansi2011))
->     [("(a)", Parens (Iden [Name Nothing "a"]))
->     ,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])))
->     ]
-
-> functionsWithReservedNames :: TestItem
-> functionsWithReservedNames = Group "functionsWithReservedNames" $ map t
->     ["abs"
->     ,"char_length"
->     ]
->   where
->     t fn = TestScalarExpr ansi2011 (fn ++ "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]
-

tools/Language/SQL/SimpleSQL/TableRefs.hs

@@ -0,0 +1,107 @@
+
+{-
+These are the tests for parsing focusing on the from part of query
+expression
+-}
+
+module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where
+
+import Language.SQL.SimpleSQL.TestTypes
+import Language.SQL.SimpleSQL.Syntax
+
+
+tableRefTests :: TestItem
+tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))
+    [("select a from t"
+     ,ms [TRSimple [Name Nothing "t"]])
+
+     ,("select a from f(a)"
+      ,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])
+
+    ,("select a from t,u"
+     ,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]])
+
+    ,("select a from s.t"
+     ,ms [TRSimple [Name Nothing "s", Name Nothing "t"]])
+
+-- these lateral queries make no sense but the syntax is valid
+
+    ,("select a from lateral a"
+     ,ms [TRLateral $ TRSimple [Name Nothing "a"]])
+
+    ,("select a from lateral a,b"
+     ,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]])
+
+    ,("select a from a, lateral b"
+     ,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]])
+
+    ,("select a from a natural join lateral b"
+     ,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner
+                 (TRLateral $ TRSimple [Name Nothing "b"])
+                 Nothing])
+
+    ,("select a from lateral a natural join lateral b"
+     ,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner
+                 (TRLateral $ TRSimple [Name Nothing "b"])
+                 Nothing])
+
+
+    ,("select a from t inner join u on expr"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
+                       (Just $ JoinOn $ Iden [Name Nothing "expr"])])
+
+    ,("select a from t join u on expr"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
+                       (Just $ JoinOn $ Iden [Name Nothing "expr"])])
+
+    ,("select a from t left join u on expr"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"])
+                       (Just $ JoinOn $ Iden [Name Nothing "expr"])])
+
+    ,("select a from t right join u on expr"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"])
+                       (Just $ JoinOn $ Iden [Name Nothing "expr"])])
+
+    ,("select a from t full join u on expr"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"])
+                       (Just $ JoinOn $ Iden [Name Nothing "expr"])])
+
+    ,("select a from t cross join u"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False
+                       JCross (TRSimple [Name Nothing "u"]) Nothing])
+
+    ,("select a from t natural inner join u"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"])
+                       Nothing])
+
+    ,("select a from t inner join u using(a,b)"
+     ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
+                       (Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])])
+
+    ,("select a from (select a from t)"
+     ,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]])
+
+    ,("select a from t as u"
+     ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])
+
+    ,("select a from t u"
+     ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])
+
+    ,("select a from t u(b)"
+     ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])])
+
+    ,("select a from (t cross join u) as u"
+     ,ms [TRAlias (TRParens $
+                   TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing)
+                          (Alias (Name Nothing "u") Nothing)])
+     -- todo: not sure if the associativity is correct
+
+    ,("select a from t cross join u cross join v",
+       ms [TRJoin
+           (TRJoin (TRSimple [Name Nothing "t"]) False
+                   JCross (TRSimple [Name Nothing "u"]) Nothing)
+           False JCross (TRSimple [Name Nothing "v"]) Nothing])
+    ]
+  where
+    ms f = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
+                      ,qeFrom = f}

tools/Language/SQL/SimpleSQL/TableRefs.lhs

@@ -1,105 +0,0 @@
-
-These are the tests for parsing focusing on the from part of query
-expression
-
-> module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-> import Language.SQL.SimpleSQL.Syntax
-
-
-> tableRefTests :: TestItem
-> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))
->     [("select a from t"
->      ,ms [TRSimple [Name Nothing "t"]])
-
->      ,("select a from f(a)"
->       ,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])
-
->     ,("select a from t,u"
->      ,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]])
-
->     ,("select a from s.t"
->      ,ms [TRSimple [Name Nothing "s", Name Nothing "t"]])
-
-these lateral queries make no sense but the syntax is valid
-
->     ,("select a from lateral a"
->      ,ms [TRLateral $ TRSimple [Name Nothing "a"]])
-
->     ,("select a from lateral a,b"
->      ,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]])
-
->     ,("select a from a, lateral b"
->      ,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]])
-
->     ,("select a from a natural join lateral b"
->      ,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner
->                  (TRLateral $ TRSimple [Name Nothing "b"])
->                  Nothing])
-
->     ,("select a from lateral a natural join lateral b"
->      ,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner
->                  (TRLateral $ TRSimple [Name Nothing "b"])
->                  Nothing])
-
-
->     ,("select a from t inner join u on expr"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
->                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])
-
->     ,("select a from t join u on expr"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
->                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])
-
->     ,("select a from t left join u on expr"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"])
->                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])
-
->     ,("select a from t right join u on expr"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"])
->                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])
-
->     ,("select a from t full join u on expr"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"])
->                        (Just $ JoinOn $ Iden [Name Nothing "expr"])])
-
->     ,("select a from t cross join u"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False
->                        JCross (TRSimple [Name Nothing "u"]) Nothing])
-
->     ,("select a from t natural inner join u"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"])
->                        Nothing])
-
->     ,("select a from t inner join u using(a,b)"
->      ,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
->                        (Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])])
-
->     ,("select a from (select a from t)"
->      ,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]])
-
->     ,("select a from t as u"
->      ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])
-
->     ,("select a from t u"
->      ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])
-
->     ,("select a from t u(b)"
->      ,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])])
-
->     ,("select a from (t cross join u) as u"
->      ,ms [TRAlias (TRParens $
->                    TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing)
->                           (Alias (Name Nothing "u") Nothing)])
->      -- todo: not sure if the associativity is correct
-
->     ,("select a from t cross join u cross join v",
->        ms [TRJoin
->            (TRJoin (TRSimple [Name Nothing "t"]) False
->                    JCross (TRSimple [Name Nothing "u"]) Nothing)
->            False JCross (TRSimple [Name Nothing "v"]) Nothing])
->     ]
->   where
->     ms f = makeSelect {qeSelectList = [(Iden [Name Nothing "a"],Nothing)]
->                       ,qeFrom = f}

tools/Language/SQL/SimpleSQL/TestTypes.hs

@@ -0,0 +1,43 @@
+
+{-
+This is the types used to define the tests as pure data. See the
+Tests.hs module for the 'interpreter'.
+-}
+
+module Language.SQL.SimpleSQL.TestTypes
+    (TestItem(..)
+    ,module Language.SQL.SimpleSQL.Dialect
+    ) where
+
+import Language.SQL.SimpleSQL.Syntax
+import Language.SQL.SimpleSQL.Lex (Token)
+import Language.SQL.SimpleSQL.Dialect
+
+{-
+TODO: maybe make the dialect args into [dialect], then each test
+checks all the dialects mentioned work, and all the dialects not
+mentioned give a parse error. Not sure if this will be too awkward due
+to lots of tricky exceptions/variationsx.
+-}
+
+data TestItem = Group String [TestItem]
+              | TestScalarExpr Dialect String ScalarExpr
+              | TestQueryExpr Dialect String QueryExpr
+              | TestStatement Dialect String Statement
+              | TestStatements Dialect String [Statement]
+
+{-
+this just checks the sql parses without error, mostly just a
+intermediate when I'm too lazy to write out the parsed AST. These
+should all be TODO to convert to a testqueryexpr test.
+-}
+
+              | ParseQueryExpr Dialect String
+
+-- check that the string given fails to parse
+
+              | ParseQueryExprFails Dialect String
+              | ParseScalarExprFails Dialect String
+              | LexTest Dialect String [Token]
+              | LexFails Dialect String
+                deriving (Eq,Show)

tools/Language/SQL/SimpleSQL/TestTypes.lhs

@@ -1,37 +0,0 @@
-
-This is the types used to define the tests as pure data. See the
-Tests.lhs module for the 'interpreter'.
-
-> module Language.SQL.SimpleSQL.TestTypes
->     (TestItem(..)
->     ,module Language.SQL.SimpleSQL.Dialect
->     ) where
-
-> import Language.SQL.SimpleSQL.Syntax
-> import Language.SQL.SimpleSQL.Lex (Token)
-> import Language.SQL.SimpleSQL.Dialect
-
-TODO: maybe make the dialect args into [dialect], then each test
-checks all the dialects mentioned work, and all the dialects not
-mentioned give a parse error. Not sure if this will be too awkward due
-to lots of tricky exceptions/variationsx.
-
-> data TestItem = Group String [TestItem]
->               | TestScalarExpr Dialect String ScalarExpr
->               | TestQueryExpr Dialect String QueryExpr
->               | TestStatement Dialect String Statement
->               | TestStatements Dialect String [Statement]
-
-this just checks the sql parses without error, mostly just a
-intermediate when I'm too lazy to write out the parsed AST. These
-should all be TODO to convert to a testqueryexpr test.
-
->               | ParseQueryExpr Dialect String
-
-check that the string given fails to parse
-
->               | ParseQueryExprFails Dialect String
->               | ParseScalarExprFails Dialect String
->               | LexTest Dialect String [Token]
->               | LexFails Dialect String
->                 deriving (Eq,Show)

tools/Language/SQL/SimpleSQL/Tests.hs

@@ -0,0 +1,175 @@
+
+{-
+This is the main tests module which exposes the test data plus the
+Test.Framework tests. It also contains the code which converts the
+test data to the Test.Framework tests.
+-}
+
+module Language.SQL.SimpleSQL.Tests
+    (testData
+    ,tests
+    ,TestItem(..)
+    ) where
+
+import qualified Test.Tasty as T
+import qualified Test.Tasty.HUnit as H
+
+--import Language.SQL.SimpleSQL.Syntax
+import Language.SQL.SimpleSQL.Pretty
+import Language.SQL.SimpleSQL.Parse
+import Language.SQL.SimpleSQL.Lex
+
+import Language.SQL.SimpleSQL.TestTypes
+
+import Language.SQL.SimpleSQL.FullQueries
+import Language.SQL.SimpleSQL.GroupBy
+import Language.SQL.SimpleSQL.Postgres
+import Language.SQL.SimpleSQL.QueryExprComponents
+import Language.SQL.SimpleSQL.QueryExprs
+import Language.SQL.SimpleSQL.TableRefs
+import Language.SQL.SimpleSQL.ScalarExprs
+import Language.SQL.SimpleSQL.Odbc
+import Language.SQL.SimpleSQL.Tpch
+import Language.SQL.SimpleSQL.LexerTests
+import Language.SQL.SimpleSQL.EmptyStatement
+import Language.SQL.SimpleSQL.CreateIndex
+
+import Language.SQL.SimpleSQL.SQL2011Queries
+import Language.SQL.SimpleSQL.SQL2011AccessControl
+import Language.SQL.SimpleSQL.SQL2011Bits
+import Language.SQL.SimpleSQL.SQL2011DataManipulation
+import Language.SQL.SimpleSQL.SQL2011Schema
+
+import Language.SQL.SimpleSQL.MySQL
+import Language.SQL.SimpleSQL.Oracle
+import Language.SQL.SimpleSQL.CustomDialect
+
+
+{-
+Order the tests to start from the simplest first. This is also the
+order on the generated documentation.
+-}
+
+testData :: TestItem
+testData =
+    Group "parserTest"
+    [lexerTests
+    ,scalarExprTests
+    ,odbcTests
+    ,queryExprComponentTests
+    ,queryExprsTests
+    ,tableRefTests
+    ,groupByTests
+    ,fullQueriesTests
+    ,postgresTests
+    ,tpchTests
+    ,sql2011QueryTests
+    ,sql2011DataManipulationTests
+    ,sql2011SchemaTests
+    ,sql2011AccessControlTests
+    ,sql2011BitsTests
+    ,mySQLTests
+    ,oracleTests
+    ,customDialectTests
+    ,emptyStatementTests
+    ,createIndexTests
+    ]
+
+tests :: T.TestTree
+tests = itemToTest testData
+
+--runTests :: IO ()
+--runTests = void $ H.runTestTT $ itemToTest testData
+
+itemToTest :: TestItem -> T.TestTree
+itemToTest (Group nm ts) =
+    T.testGroup nm $ map itemToTest ts
+itemToTest (TestScalarExpr d str expected) =
+    toTest parseScalarExpr prettyScalarExpr d str expected
+itemToTest (TestQueryExpr d str expected) =
+    toTest parseQueryExpr prettyQueryExpr d str expected
+itemToTest (TestStatement d str expected) =
+    toTest parseStatement prettyStatement d str expected
+itemToTest (TestStatements d str expected) =
+    toTest parseStatements prettyStatements d str expected
+itemToTest (ParseQueryExpr d str) =
+    toPTest parseQueryExpr prettyQueryExpr d str
+
+itemToTest (ParseQueryExprFails d str) =
+    toFTest parseQueryExpr prettyQueryExpr d str
+
+itemToTest (ParseScalarExprFails d str) =
+    toFTest parseScalarExpr prettyScalarExpr d str
+
+itemToTest (LexTest d s ts) = makeLexerTest d s ts
+itemToTest (LexFails d s) = makeLexingFailsTest d s
+
+makeLexerTest :: Dialect -> String -> [Token] -> T.TestTree
+makeLexerTest d s ts = H.testCase s $ do
+    let lx = either (error . show) id $ lexSQL d "" Nothing s
+    H.assertEqual "" ts $ map snd lx
+    let s' = prettyTokens d $ map snd lx
+    H.assertEqual "pretty print" s s'
+
+makeLexingFailsTest :: Dialect -> String -> T.TestTree
+makeLexingFailsTest d s = H.testCase s $ do
+    case lexSQL d "" Nothing s of
+         Right x -> H.assertFailure $ "lexing should have failed: " ++ s ++ "\ngot: " ++ show x
+         Left _ -> return ()
+
+
+toTest :: (Eq a, Show a) =>
+          (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
+       -> (Dialect -> a -> String)
+       -> Dialect
+       -> String
+       -> a
+       -> T.TestTree
+toTest parser pp d str expected = H.testCase str $ do
+        let egot = parser d "" Nothing str
+        case egot of
+            Left e -> H.assertFailure $ peFormattedError e
+            Right got -> do
+                H.assertEqual "" expected got
+                let str' = pp d got
+                let egot' = parser d "" Nothing str'
+                case egot' of
+                    Left e' -> H.assertFailure $ "pp roundtrip"
+                                                 ++ "\n" ++ str'
+                                                 ++ peFormattedError e'
+                    Right got' -> H.assertEqual
+                                  ("pp roundtrip" ++ "\n" ++ str')
+                                   expected got'
+
+toPTest :: (Eq a, Show a) =>
+          (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
+       -> (Dialect -> a -> String)
+       -> Dialect
+       -> String
+       -> T.TestTree
+toPTest parser pp d str = H.testCase str $ do
+        let egot = parser d "" Nothing str
+        case egot of
+            Left e -> H.assertFailure $ peFormattedError e
+            Right got -> do
+                let str' = pp d got
+                let egot' = parser d "" Nothing str'
+                case egot' of
+                    Left e' -> H.assertFailure $ "pp roundtrip "
+                                                 ++ "\n" ++ str' ++ "\n"
+                                                 ++ peFormattedError e'
+                    Right _got' -> return ()
+
+
+toFTest :: (Eq a, Show a) =>
+          (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
+       -> (Dialect -> a -> String)
+       -> Dialect
+       -> String
+       -> T.TestTree
+toFTest parser _pp d str = H.testCase str $ do
+        let egot = parser d "" Nothing str
+        case egot of
+            Left _e -> return ()
+            Right _got ->
+              H.assertFailure $ "parse didn't fail: " ++ show d ++ "\n" ++ str

tools/Language/SQL/SimpleSQL/Tests.lhs

@@ -1,171 +0,0 @@
-
-This is the main tests module which exposes the test data plus the
-Test.Framework tests. It also contains the code which converts the
-test data to the Test.Framework tests.
-
-> module Language.SQL.SimpleSQL.Tests
->     (testData
->     ,tests
->     ,TestItem(..)
->     ) where
-
-> import qualified Test.Tasty as T
-> import qualified Test.Tasty.HUnit as H
-
-> --import Language.SQL.SimpleSQL.Syntax
-> import Language.SQL.SimpleSQL.Pretty
-> import Language.SQL.SimpleSQL.Parse
-> import Language.SQL.SimpleSQL.Lex
-
-> import Language.SQL.SimpleSQL.TestTypes
-
-> import Language.SQL.SimpleSQL.FullQueries
-> import Language.SQL.SimpleSQL.GroupBy
-> import Language.SQL.SimpleSQL.Postgres
-> import Language.SQL.SimpleSQL.QueryExprComponents
-> import Language.SQL.SimpleSQL.QueryExprs
-> import Language.SQL.SimpleSQL.TableRefs
-> import Language.SQL.SimpleSQL.ScalarExprs
-> import Language.SQL.SimpleSQL.Odbc
-> import Language.SQL.SimpleSQL.Tpch
-> import Language.SQL.SimpleSQL.LexerTests
-> import Language.SQL.SimpleSQL.EmptyStatement
-> import Language.SQL.SimpleSQL.CreateIndex
-
-> import Language.SQL.SimpleSQL.SQL2011Queries
-> import Language.SQL.SimpleSQL.SQL2011AccessControl
-> import Language.SQL.SimpleSQL.SQL2011Bits
-> import Language.SQL.SimpleSQL.SQL2011DataManipulation
-> import Language.SQL.SimpleSQL.SQL2011Schema
-
-> import Language.SQL.SimpleSQL.MySQL
-> import Language.SQL.SimpleSQL.Oracle
-> import Language.SQL.SimpleSQL.CustomDialect
-
-
-Order the tests to start from the simplest first. This is also the
-order on the generated documentation.
-
-> testData :: TestItem
-> testData =
->     Group "parserTest"
->     [lexerTests
->     ,scalarExprTests
->     ,odbcTests
->     ,queryExprComponentTests
->     ,queryExprsTests
->     ,tableRefTests
->     ,groupByTests
->     ,fullQueriesTests
->     ,postgresTests
->     ,tpchTests
->     ,sql2011QueryTests
->     ,sql2011DataManipulationTests
->     ,sql2011SchemaTests
->     ,sql2011AccessControlTests
->     ,sql2011BitsTests
->     ,mySQLTests
->     ,oracleTests
->     ,customDialectTests
->     ,emptyStatementTests
->     ,createIndexTests
->     ]
-
-> tests :: T.TestTree
-> tests = itemToTest testData
-
-> --runTests :: IO ()
-> --runTests = void $ H.runTestTT $ itemToTest testData
-
-> itemToTest :: TestItem -> T.TestTree
-> itemToTest (Group nm ts) =
->     T.testGroup nm $ map itemToTest ts
-> itemToTest (TestScalarExpr d str expected) =
->     toTest parseScalarExpr prettyScalarExpr d str expected
-> itemToTest (TestQueryExpr d str expected) =
->     toTest parseQueryExpr prettyQueryExpr d str expected
-> itemToTest (TestStatement d str expected) =
->     toTest parseStatement prettyStatement d str expected
-> itemToTest (TestStatements d str expected) =
->     toTest parseStatements prettyStatements d str expected
-> itemToTest (ParseQueryExpr d str) =
->     toPTest parseQueryExpr prettyQueryExpr d str
-
-> itemToTest (ParseQueryExprFails d str) =
->     toFTest parseQueryExpr prettyQueryExpr d str
-
-> itemToTest (ParseScalarExprFails d str) =
->     toFTest parseScalarExpr prettyScalarExpr d str
-
-> itemToTest (LexTest d s ts) = makeLexerTest d s ts
-> itemToTest (LexFails d s) = makeLexingFailsTest d s
-
-> makeLexerTest :: Dialect -> String -> [Token] -> T.TestTree
-> makeLexerTest d s ts = H.testCase s $ do
->     let lx = either (error . show) id $ lexSQL d "" Nothing s
->     H.assertEqual "" ts $ map snd lx
->     let s' = prettyTokens d $ map snd lx
->     H.assertEqual "pretty print" s s'
-
-> makeLexingFailsTest :: Dialect -> String -> T.TestTree
-> makeLexingFailsTest d s = H.testCase s $ do
->     case lexSQL d "" Nothing s of
->          Right x -> H.assertFailure $ "lexing should have failed: " ++ s ++ "\ngot: " ++ show x
->          Left _ -> return ()
-
-
-> toTest :: (Eq a, Show a) =>
->           (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
->        -> (Dialect -> a -> String)
->        -> Dialect
->        -> String
->        -> a
->        -> T.TestTree
-> toTest parser pp d str expected = H.testCase str $ do
->         let egot = parser d "" Nothing str
->         case egot of
->             Left e -> H.assertFailure $ peFormattedError e
->             Right got -> do
->                 H.assertEqual "" expected got
->                 let str' = pp d got
->                 let egot' = parser d "" Nothing str'
->                 case egot' of
->                     Left e' -> H.assertFailure $ "pp roundtrip"
->                                                  ++ "\n" ++ str'
->                                                  ++ peFormattedError e'
->                     Right got' -> H.assertEqual
->                                   ("pp roundtrip" ++ "\n" ++ str')
->                                    expected got'
-
-> toPTest :: (Eq a, Show a) =>
->           (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
->        -> (Dialect -> a -> String)
->        -> Dialect
->        -> String
->        -> T.TestTree
-> toPTest parser pp d str = H.testCase str $ do
->         let egot = parser d "" Nothing str
->         case egot of
->             Left e -> H.assertFailure $ peFormattedError e
->             Right got -> do
->                 let str' = pp d got
->                 let egot' = parser d "" Nothing str'
->                 case egot' of
->                     Left e' -> H.assertFailure $ "pp roundtrip "
->                                                  ++ "\n" ++ str' ++ "\n"
->                                                  ++ peFormattedError e'
->                     Right _got' -> return ()
-
-
-> toFTest :: (Eq a, Show a) =>
->           (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
->        -> (Dialect -> a -> String)
->        -> Dialect
->        -> String
->        -> T.TestTree
-> toFTest parser _pp d str = H.testCase str $ do
->         let egot = parser d "" Nothing str
->         case egot of
->             Left _e -> return ()
->             Right _got ->
->               H.assertFailure $ "parse didn't fail: " ++ show d ++ "\n" ++ str

tools/Language/SQL/SimpleSQL/Tpch.hs

@@ -0,0 +1,685 @@
+
+{-
+Some tests for parsing the tpch queries
+
+The changes made to the official syntax are:
+1. replace the set rowcount with ansi standard fetch first n rows only
+2. replace the create view, query, drop view sequence with a query
+   using a common table expression
+-}
+
+module Language.SQL.SimpleSQL.Tpch (tpchTests,tpchQueries) where
+
+import Language.SQL.SimpleSQL.TestTypes
+
+tpchTests :: TestItem
+tpchTests =
+    Group "parse tpch"
+    $ map (ParseQueryExpr ansi2011 . snd) tpchQueries
+
+tpchQueries :: [(String,String)]
+tpchQueries =
+  [("Q1","\n\
+         \select\n\
+         \        l_returnflag,\n\
+         \        l_linestatus,\n\
+         \        sum(l_quantity) as sum_qty,\n\
+         \        sum(l_extendedprice) as sum_base_price,\n\
+         \        sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,\n\
+         \        sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,\n\
+         \        avg(l_quantity) as avg_qty,\n\
+         \        avg(l_extendedprice) as avg_price,\n\
+         \        avg(l_discount) as avg_disc,\n\
+         \        count(*) as count_order\n\
+         \from\n\
+         \        lineitem\n\
+         \where\n\
+         \        l_shipdate <= date '1998-12-01' - interval '63' day (3)\n\
+         \group by\n\
+         \        l_returnflag,\n\
+         \        l_linestatus\n\
+         \order by\n\
+         \        l_returnflag,\n\
+         \        l_linestatus")
+  ,("Q2","\n\
+         \select\n\
+         \        s_acctbal,\n\
+         \        s_name,\n\
+         \        n_name,\n\
+         \        p_partkey,\n\
+         \        p_mfgr,\n\
+         \        s_address,\n\
+         \        s_phone,\n\
+         \        s_comment\n\
+         \from\n\
+         \        part,\n\
+         \        supplier,\n\
+         \        partsupp,\n\
+         \        nation,\n\
+         \        region\n\
+         \where\n\
+         \        p_partkey = ps_partkey\n\
+         \        and s_suppkey = ps_suppkey\n\
+         \        and p_size = 15\n\
+         \        and p_type like '%BRASS'\n\
+         \        and s_nationkey = n_nationkey\n\
+         \        and n_regionkey = r_regionkey\n\
+         \        and r_name = 'EUROPE'\n\
+         \        and ps_supplycost = (\n\
+         \                select\n\
+         \                        min(ps_supplycost)\n\
+         \                from\n\
+         \                        partsupp,\n\
+         \                        supplier,\n\
+         \                        nation,\n\
+         \                        region\n\
+         \                where\n\
+         \                        p_partkey = ps_partkey\n\
+         \                        and s_suppkey = ps_suppkey\n\
+         \                        and s_nationkey = n_nationkey\n\
+         \                        and n_regionkey = r_regionkey\n\
+         \                        and r_name = 'EUROPE'\n\
+         \        )\n\
+         \order by\n\
+         \        s_acctbal desc,\n\
+         \        n_name,\n\
+         \        s_name,\n\
+         \        p_partkey\n\
+         \fetch first 100 rows only")
+  ,("Q3","\n\
+         \ select\n\
+         \         l_orderkey,\n\
+         \         sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
+         \         o_orderdate,\n\
+         \         o_shippriority\n\
+         \ from\n\
+         \         customer,\n\
+         \         orders,\n\
+         \         lineitem\n\
+         \ where\n\
+         \         c_mktsegment = 'MACHINERY'\n\
+         \         and c_custkey = o_custkey\n\
+         \         and l_orderkey = o_orderkey\n\
+         \         and o_orderdate < date '1995-03-21'\n\
+         \         and l_shipdate > date '1995-03-21'\n\
+         \ group by\n\
+         \         l_orderkey,\n\
+         \         o_orderdate,\n\
+         \         o_shippriority\n\
+         \ order by\n\
+         \         revenue desc,\n\
+         \         o_orderdate\n\
+         \ fetch first 10 rows only")
+  ,("Q4","\n\
+         \ select\n\
+         \         o_orderpriority,\n\
+         \         count(*) as order_count\n\
+         \ from\n\
+         \         orders\n\
+         \ where\n\
+         \         o_orderdate >= date '1996-03-01'\n\
+         \         and o_orderdate < date '1996-03-01' + interval '3' month\n\
+         \         and exists (\n\
+         \                 select\n\
+         \                         *\n\
+         \                 from\n\
+         \                         lineitem\n\
+         \                 where\n\
+         \                         l_orderkey = o_orderkey\n\
+         \                         and l_commitdate < l_receiptdate\n\
+         \         )\n\
+         \ group by\n\
+         \         o_orderpriority\n\
+         \ order by\n\
+         \         o_orderpriority")
+  ,("Q5","\n\
+         \ select\n\
+         \         n_name,\n\
+         \         sum(l_extendedprice * (1 - l_discount)) as revenue\n\
+         \ from\n\
+         \         customer,\n\
+         \         orders,\n\
+         \         lineitem,\n\
+         \         supplier,\n\
+         \         nation,\n\
+         \         region\n\
+         \ where\n\
+         \         c_custkey = o_custkey\n\
+         \         and l_orderkey = o_orderkey\n\
+         \         and l_suppkey = s_suppkey\n\
+         \         and c_nationkey = s_nationkey\n\
+         \         and s_nationkey = n_nationkey\n\
+         \         and n_regionkey = r_regionkey\n\
+         \         and r_name = 'EUROPE'\n\
+         \         and o_orderdate >= date '1997-01-01'\n\
+         \         and o_orderdate < date '1997-01-01' + interval '1' year\n\
+         \ group by\n\
+         \         n_name\n\
+         \ order by\n\
+         \         revenue desc")
+  ,("Q6","\n\
+         \ select\n\
+         \         sum(l_extendedprice * l_discount) as revenue\n\
+         \ from\n\
+         \         lineitem\n\
+         \ where\n\
+         \         l_shipdate >= date '1997-01-01'\n\
+         \         and l_shipdate < date '1997-01-01' + interval '1' year\n\
+         \         and l_discount between 0.07 - 0.01 and 0.07 + 0.01\n\
+         \         and l_quantity < 24")
+  ,("Q7","\n\
+         \ select\n\
+         \         supp_nation,\n\
+         \         cust_nation,\n\
+         \         l_year,\n\
+         \         sum(volume) as revenue\n\
+         \ from\n\
+         \         (\n\
+         \                 select\n\
+         \                         n1.n_name as supp_nation,\n\
+         \                         n2.n_name as cust_nation,\n\
+         \                         extract(year from l_shipdate) as l_year,\n\
+         \                         l_extendedprice * (1 - l_discount) as volume\n\
+         \                 from\n\
+         \                         supplier,\n\
+         \                         lineitem,\n\
+         \                         orders,\n\
+         \                         customer,\n\
+         \                         nation n1,\n\
+         \                         nation n2\n\
+         \                 where\n\
+         \                         s_suppkey = l_suppkey\n\
+         \                         and o_orderkey = l_orderkey\n\
+         \                         and c_custkey = o_custkey\n\
+         \                         and s_nationkey = n1.n_nationkey\n\
+         \                         and c_nationkey = n2.n_nationkey\n\
+         \                         and (\n\
+         \                                 (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')\n\
+         \                                 or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')\n\
+         \                         )\n\
+         \                         and l_shipdate between date '1995-01-01' and date '1996-12-31'\n\
+         \         ) as shipping\n\
+         \ group by\n\
+         \         supp_nation,\n\
+         \         cust_nation,\n\
+         \         l_year\n\
+         \ order by\n\
+         \         supp_nation,\n\
+         \         cust_nation,\n\
+         \         l_year")
+  ,("Q8","\n\
+         \ select\n\
+         \         o_year,\n\
+         \         sum(case\n\
+         \                 when nation = 'IRAQ' then volume\n\
+         \                 else 0\n\
+         \         end) / sum(volume) as mkt_share\n\
+         \ from\n\
+         \         (\n\
+         \                 select\n\
+         \                         extract(year from o_orderdate) as o_year,\n\
+         \                         l_extendedprice * (1 - l_discount) as volume,\n\
+         \                         n2.n_name as nation\n\
+         \                 from\n\
+         \                         part,\n\
+         \                         supplier,\n\
+         \                         lineitem,\n\
+         \                         orders,\n\
+         \                         customer,\n\
+         \                         nation n1,\n\
+         \                         nation n2,\n\
+         \                         region\n\
+         \                 where\n\
+         \                         p_partkey = l_partkey\n\
+         \                         and s_suppkey = l_suppkey\n\
+         \                         and l_orderkey = o_orderkey\n\
+         \                         and o_custkey = c_custkey\n\
+         \                         and c_nationkey = n1.n_nationkey\n\
+         \                         and n1.n_regionkey = r_regionkey\n\
+         \                         and r_name = 'MIDDLE EAST'\n\
+         \                         and s_nationkey = n2.n_nationkey\n\
+         \                         and o_orderdate between date '1995-01-01' and date '1996-12-31'\n\
+         \                         and p_type = 'STANDARD ANODIZED BRASS'\n\
+         \         ) as all_nations\n\
+         \ group by\n\
+         \         o_year\n\
+         \ order by\n\
+         \         o_year")
+   ,("Q9","\n\
+         \ select\n\
+         \         nation,\n\
+         \         o_year,\n\
+         \         sum(amount) as sum_profit\n\
+         \ from\n\
+         \         (\n\
+         \                 select\n\
+         \                         n_name as nation,\n\
+         \                         extract(year from o_orderdate) as o_year,\n\
+         \                         l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount\n\
+         \                 from\n\
+         \                         part,\n\
+         \                         supplier,\n\
+         \                         lineitem,\n\
+         \                         partsupp,\n\
+         \                         orders,\n\
+         \                         nation\n\
+         \                 where\n\
+         \                         s_suppkey = l_suppkey\n\
+         \                         and ps_suppkey = l_suppkey\n\
+         \                         and ps_partkey = l_partkey\n\
+         \                         and p_partkey = l_partkey\n\
+         \                         and o_orderkey = l_orderkey\n\
+         \                         and s_nationkey = n_nationkey\n\
+         \                         and p_name like '%antique%'\n\
+         \         ) as profit\n\
+         \ group by\n\
+         \         nation,\n\
+         \         o_year\n\
+         \ order by\n\
+         \         nation,\n\
+         \         o_year desc")
+   ,("Q10","\n\
+         \ select\n\
+         \         c_custkey,\n\
+         \         c_name,\n\
+         \         sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
+         \         c_acctbal,\n\
+         \         n_name,\n\
+         \         c_address,\n\
+         \         c_phone,\n\
+         \         c_comment\n\
+         \ from\n\
+         \         customer,\n\
+         \         orders,\n\
+         \         lineitem,\n\
+         \         nation\n\
+         \ where\n\
+         \         c_custkey = o_custkey\n\
+         \         and l_orderkey = o_orderkey\n\
+         \         and o_orderdate >= date '1993-12-01'\n\
+         \         and o_orderdate < date '1993-12-01' + interval '3' month\n\
+         \         and l_returnflag = 'R'\n\
+         \         and c_nationkey = n_nationkey\n\
+         \ group by\n\
+         \         c_custkey,\n\
+         \         c_name,\n\
+         \         c_acctbal,\n\
+         \         c_phone,\n\
+         \         n_name,\n\
+         \         c_address,\n\
+         \         c_comment\n\
+         \ order by\n\
+         \         revenue desc\n\
+         \ fetch first 20 rows only")
+   ,("Q11","\n\
+         \ select\n\
+         \         ps_partkey,\n\
+         \         sum(ps_supplycost * ps_availqty) as value\n\
+         \ from\n\
+         \         partsupp,\n\
+         \         supplier,\n\
+         \         nation\n\
+         \ where\n\
+         \         ps_suppkey = s_suppkey\n\
+         \         and s_nationkey = n_nationkey\n\
+         \         and n_name = 'CHINA'\n\
+         \ group by\n\
+         \         ps_partkey having\n\
+         \                 sum(ps_supplycost * ps_availqty) > (\n\
+         \                         select\n\
+         \                                 sum(ps_supplycost * ps_availqty) * 0.0001000000\n\
+         \                         from\n\
+         \                                 partsupp,\n\
+         \                                 supplier,\n\
+         \                                 nation\n\
+         \                         where\n\
+         \                                 ps_suppkey = s_suppkey\n\
+         \                                 and s_nationkey = n_nationkey\n\
+         \                                 and n_name = 'CHINA'\n\
+         \                 )\n\
+         \ order by\n\
+         \         value desc")
+   ,("Q12","\n\
+         \ select\n\
+         \         l_shipmode,\n\
+         \         sum(case\n\
+         \                 when o_orderpriority = '1-URGENT'\n\
+         \                         or o_orderpriority = '2-HIGH'\n\
+         \                         then 1\n\
+         \                 else 0\n\
+         \         end) as high_line_count,\n\
+         \         sum(case\n\
+         \                 when o_orderpriority <> '1-URGENT'\n\
+         \                         and o_orderpriority <> '2-HIGH'\n\
+         \                         then 1\n\
+         \                 else 0\n\
+         \         end) as low_line_count\n\
+         \ from\n\
+         \         orders,\n\
+         \         lineitem\n\
+         \ where\n\
+         \         o_orderkey = l_orderkey\n\
+         \         and l_shipmode in ('AIR', 'RAIL')\n\
+         \         and l_commitdate < l_receiptdate\n\
+         \         and l_shipdate < l_commitdate\n\
+         \         and l_receiptdate >= date '1994-01-01'\n\
+         \         and l_receiptdate < date '1994-01-01' + interval '1' year\n\
+         \ group by\n\
+         \         l_shipmode\n\
+         \ order by\n\
+         \         l_shipmode")
+   ,("Q13","\n\
+         \ select\n\
+         \         c_count,\n\
+         \         count(*) as custdist\n\
+         \ from\n\
+         \         (\n\
+         \                 select\n\
+         \                         c_custkey,\n\
+         \                         count(o_orderkey)\n\
+         \                 from\n\
+         \                         customer left outer join orders on\n\
+         \                                 c_custkey = o_custkey\n\
+         \                                 and o_comment not like '%pending%requests%'\n\
+         \                 group by\n\
+         \                         c_custkey\n\
+         \         ) as c_orders (c_custkey, c_count)\n\
+         \ group by\n\
+         \         c_count\n\
+         \ order by\n\
+         \         custdist desc,\n\
+         \         c_count desc")
+   ,("Q14","\n\
+         \ select\n\
+         \         100.00 * sum(case\n\
+         \                 when p_type like 'PROMO%'\n\
+         \                         then l_extendedprice * (1 - l_discount)\n\
+         \                 else 0\n\
+         \         end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue\n\
+         \ from\n\
+         \         lineitem,\n\
+         \         part\n\
+         \ where\n\
+         \         l_partkey = p_partkey\n\
+         \         and l_shipdate >= date '1994-12-01'\n\
+         \         and l_shipdate < date '1994-12-01' + interval '1' month")
+   ,("Q15","\n\
+         \ /*create view revenue0 (supplier_no, total_revenue) as\n\
+         \         select\n\
+         \                 l_suppkey,\n\
+         \                 sum(l_extendedprice * (1 - l_discount))\n\
+         \         from\n\
+         \                 lineitem\n\
+         \         where\n\
+         \                 l_shipdate >= date '1995-06-01'\n\
+         \                 and l_shipdate < date '1995-06-01' + interval '3' month\n\
+         \         group by\n\
+         \                 l_suppkey;*/\n\
+         \ with\n\
+         \ revenue0 as\n\
+         \         (select\n\
+         \                 l_suppkey as supplier_no,\n\
+         \                 sum(l_extendedprice * (1 - l_discount)) as total_revenue\n\
+         \         from\n\
+         \                 lineitem\n\
+         \         where\n\
+         \                 l_shipdate >= date '1995-06-01'\n\
+         \                 and l_shipdate < date '1995-06-01' + interval '3' month\n\
+         \         group by\n\
+         \                 l_suppkey)\n\
+         \ select\n\
+         \         s_suppkey,\n\
+         \         s_name,\n\
+         \         s_address,\n\
+         \         s_phone,\n\
+         \         total_revenue\n\
+         \ from\n\
+         \         supplier,\n\
+         \         revenue0\n\
+         \ where\n\
+         \         s_suppkey = supplier_no\n\
+         \         and total_revenue = (\n\
+         \                 select\n\
+         \                         max(total_revenue)\n\
+         \                 from\n\
+         \                         revenue0\n\
+         \         )\n\
+         \ order by\n\
+         \         s_suppkey")
+   ,("Q16","\n\
+         \ select\n\
+         \         p_brand,\n\
+         \         p_type,\n\
+         \         p_size,\n\
+         \         count(distinct ps_suppkey) as supplier_cnt\n\
+         \ from\n\
+         \         partsupp,\n\
+         \         part\n\
+         \ where\n\
+         \         p_partkey = ps_partkey\n\
+         \         and p_brand <> 'Brand#15'\n\
+         \         and p_type not like 'MEDIUM BURNISHED%'\n\
+         \         and p_size in (39, 26, 18, 45, 19, 1, 3, 9)\n\
+         \         and ps_suppkey not in (\n\
+         \                 select\n\
+         \                         s_suppkey\n\
+         \                 from\n\
+         \                         supplier\n\
+         \                 where\n\
+         \                         s_comment like '%Customer%Complaints%'\n\
+         \         )\n\
+         \ group by\n\
+         \         p_brand,\n\
+         \         p_type,\n\
+         \         p_size\n\
+         \ order by\n\
+         \         supplier_cnt desc,\n\
+         \         p_brand,\n\
+         \         p_type,\n\
+         \         p_size")
+   ,("Q17","\n\
+         \ select\n\
+         \         sum(l_extendedprice) / 7.0 as avg_yearly\n\
+         \ from\n\
+         \         lineitem,\n\
+         \         part\n\
+         \ where\n\
+         \         p_partkey = l_partkey\n\
+         \         and p_brand = 'Brand#52'\n\
+         \         and p_container = 'JUMBO CAN'\n\
+         \         and l_quantity < (\n\
+         \                 select\n\
+         \                         0.2 * avg(l_quantity)\n\
+         \                 from\n\
+         \                         lineitem\n\
+         \                 where\n\
+         \                         l_partkey = p_partkey\n\
+         \         )")
+   ,("Q18","\n\
+         \ select\n\
+         \         c_name,\n\
+         \         c_custkey,\n\
+         \         o_orderkey,\n\
+         \         o_orderdate,\n\
+         \         o_totalprice,\n\
+         \         sum(l_quantity)\n\
+         \ from\n\
+         \         customer,\n\
+         \         orders,\n\
+         \         lineitem\n\
+         \ where\n\
+         \         o_orderkey in (\n\
+         \                 select\n\
+         \                         l_orderkey\n\
+         \                 from\n\
+         \                         lineitem\n\
+         \                 group by\n\
+         \                         l_orderkey having\n\
+         \                                 sum(l_quantity) > 313\n\
+         \         )\n\
+         \         and c_custkey = o_custkey\n\
+         \         and o_orderkey = l_orderkey\n\
+         \ group by\n\
+         \         c_name,\n\
+         \         c_custkey,\n\
+         \         o_orderkey,\n\
+         \         o_orderdate,\n\
+         \         o_totalprice\n\
+         \ order by\n\
+         \         o_totalprice desc,\n\
+         \         o_orderdate\n\
+         \ fetch first 100 rows only")
+   ,("Q19","\n\
+         \ select\n\
+         \         sum(l_extendedprice* (1 - l_discount)) as revenue\n\
+         \ from\n\
+         \         lineitem,\n\
+         \         part\n\
+         \ where\n\
+         \         (\n\
+         \                 p_partkey = l_partkey\n\
+         \                 and p_brand = 'Brand#43'\n\
+         \                 and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')\n\
+         \                 and l_quantity >= 3 and l_quantity <= 3 + 10\n\
+         \                 and p_size between 1 and 5\n\
+         \                 and l_shipmode in ('AIR', 'AIR REG')\n\
+         \                 and l_shipinstruct = 'DELIVER IN PERSON'\n\
+         \         )\n\
+         \         or\n\
+         \         (\n\
+         \                 p_partkey = l_partkey\n\
+         \                 and p_brand = 'Brand#25'\n\
+         \                 and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')\n\
+         \                 and l_quantity >= 10 and l_quantity <= 10 + 10\n\
+         \                 and p_size between 1 and 10\n\
+         \                 and l_shipmode in ('AIR', 'AIR REG')\n\
+         \                 and l_shipinstruct = 'DELIVER IN PERSON'\n\
+         \         )\n\
+         \         or\n\
+         \         (\n\
+         \                 p_partkey = l_partkey\n\
+         \                 and p_brand = 'Brand#24'\n\
+         \                 and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')\n\
+         \                 and l_quantity >= 22 and l_quantity <= 22 + 10\n\
+         \                 and p_size between 1 and 15\n\
+         \                 and l_shipmode in ('AIR', 'AIR REG')\n\
+         \                 and l_shipinstruct = 'DELIVER IN PERSON'\n\
+         \         )")
+   ,("Q20","\n\
+         \ select\n\
+         \         s_name,\n\
+         \         s_address\n\
+         \ from\n\
+         \         supplier,\n\
+         \         nation\n\
+         \ where\n\
+         \         s_suppkey in (\n\
+         \                 select\n\
+         \                         ps_suppkey\n\
+         \                 from\n\
+         \                         partsupp\n\
+         \                 where\n\
+         \                         ps_partkey in (\n\
+         \                                 select\n\
+         \                                         p_partkey\n\
+         \                                 from\n\
+         \                                         part\n\
+         \                                 where\n\
+         \                                         p_name like 'lime%'\n\
+         \                         )\n\
+         \                         and ps_availqty > (\n\
+         \                                 select\n\
+         \                                         0.5 * sum(l_quantity)\n\
+         \                                 from\n\
+         \                                         lineitem\n\
+         \                                 where\n\
+         \                                         l_partkey = ps_partkey\n\
+         \                                         and l_suppkey = ps_suppkey\n\
+         \                                         and l_shipdate >= date '1994-01-01'\n\
+         \                                         and l_shipdate < date '1994-01-01' + interval '1' year\n\
+         \                         )\n\
+         \         )\n\
+         \         and s_nationkey = n_nationkey\n\
+         \         and n_name = 'VIETNAM'\n\
+         \ order by\n\
+         \         s_name")
+   ,("Q21","\n\
+         \ select\n\
+         \         s_name,\n\
+         \         count(*) as numwait\n\
+         \ from\n\
+         \         supplier,\n\
+         \         lineitem l1,\n\
+         \         orders,\n\
+         \         nation\n\
+         \ where\n\
+         \         s_suppkey = l1.l_suppkey\n\
+         \         and o_orderkey = l1.l_orderkey\n\
+         \         and o_orderstatus = 'F'\n\
+         \         and l1.l_receiptdate > l1.l_commitdate\n\
+         \         and exists (\n\
+         \                 select\n\
+         \                         *\n\
+         \                 from\n\
+         \                         lineitem l2\n\
+         \                 where\n\
+         \                         l2.l_orderkey = l1.l_orderkey\n\
+         \                         and l2.l_suppkey <> l1.l_suppkey\n\
+         \         )\n\
+         \         and not exists (\n\
+         \                 select\n\
+         \                         *\n\
+         \                 from\n\
+         \                         lineitem l3\n\
+         \                 where\n\
+         \                         l3.l_orderkey = l1.l_orderkey\n\
+         \                         and l3.l_suppkey <> l1.l_suppkey\n\
+         \                         and l3.l_receiptdate > l3.l_commitdate\n\
+         \         )\n\
+         \         and s_nationkey = n_nationkey\n\
+         \         and n_name = 'INDIA'\n\
+         \ group by\n\
+         \         s_name\n\
+         \ order by\n\
+         \         numwait desc,\n\
+         \         s_name\n\
+         \ fetch first 100 rows only")
+   ,("Q22","\n\
+         \ select\n\
+         \         cntrycode,\n\
+         \         count(*) as numcust,\n\
+         \         sum(c_acctbal) as totacctbal\n\
+         \ from\n\
+         \         (\n\
+         \                 select\n\
+         \                         substring(c_phone from 1 for 2) as cntrycode,\n\
+         \                         c_acctbal\n\
+         \                 from\n\
+         \                         customer\n\
+         \                 where\n\
+         \                         substring(c_phone from 1 for 2) in\n\
+         \                                 ('41', '28', '39', '21', '24', '29', '44')\n\
+         \                         and c_acctbal > (\n\
+         \                                 select\n\
+         \                                         avg(c_acctbal)\n\
+         \                                 from\n\
+         \                                         customer\n\
+         \                                 where\n\
+         \                                         c_acctbal > 0.00\n\
+         \                                         and substring(c_phone from 1 for 2) in\n\
+         \                                                 ('41', '28', '39', '21', '24', '29', '44')\n\
+         \                         )\n\
+         \                         and not exists (\n\
+         \                                 select\n\
+         \                                         *\n\
+         \                                 from\n\
+         \                                         orders\n\
+         \                                 where\n\
+         \                                         o_custkey = c_custkey\n\
+         \                         )\n\
+         \         ) as custsale\n\
+         \ group by\n\
+         \         cntrycode\n\
+         \ order by\n\
+         \         cntrycode")
+  ]

tools/Language/SQL/SimpleSQL/Tpch.lhs

@@ -1,683 +0,0 @@
-
-Some tests for parsing the tpch queries
-
-The changes made to the official syntax are:
-1. replace the set rowcount with ansi standard fetch first n rows only
-2. replace the create view, query, drop view sequence with a query
-   using a common table expression
-
-> module Language.SQL.SimpleSQL.Tpch (tpchTests,tpchQueries) where
-
-> import Language.SQL.SimpleSQL.TestTypes
-
-> tpchTests :: TestItem
-> tpchTests =
->     Group "parse tpch"
->     $ map (ParseQueryExpr ansi2011 . snd) tpchQueries
-
-> tpchQueries :: [(String,String)]
-> tpchQueries =
->   [("Q1","\n\
->          \select\n\
->          \        l_returnflag,\n\
->          \        l_linestatus,\n\
->          \        sum(l_quantity) as sum_qty,\n\
->          \        sum(l_extendedprice) as sum_base_price,\n\
->          \        sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,\n\
->          \        sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,\n\
->          \        avg(l_quantity) as avg_qty,\n\
->          \        avg(l_extendedprice) as avg_price,\n\
->          \        avg(l_discount) as avg_disc,\n\
->          \        count(*) as count_order\n\
->          \from\n\
->          \        lineitem\n\
->          \where\n\
->          \        l_shipdate <= date '1998-12-01' - interval '63' day (3)\n\
->          \group by\n\
->          \        l_returnflag,\n\
->          \        l_linestatus\n\
->          \order by\n\
->          \        l_returnflag,\n\
->          \        l_linestatus")
->   ,("Q2","\n\
->          \select\n\
->          \        s_acctbal,\n\
->          \        s_name,\n\
->          \        n_name,\n\
->          \        p_partkey,\n\
->          \        p_mfgr,\n\
->          \        s_address,\n\
->          \        s_phone,\n\
->          \        s_comment\n\
->          \from\n\
->          \        part,\n\
->          \        supplier,\n\
->          \        partsupp,\n\
->          \        nation,\n\
->          \        region\n\
->          \where\n\
->          \        p_partkey = ps_partkey\n\
->          \        and s_suppkey = ps_suppkey\n\
->          \        and p_size = 15\n\
->          \        and p_type like '%BRASS'\n\
->          \        and s_nationkey = n_nationkey\n\
->          \        and n_regionkey = r_regionkey\n\
->          \        and r_name = 'EUROPE'\n\
->          \        and ps_supplycost = (\n\
->          \                select\n\
->          \                        min(ps_supplycost)\n\
->          \                from\n\
->          \                        partsupp,\n\
->          \                        supplier,\n\
->          \                        nation,\n\
->          \                        region\n\
->          \                where\n\
->          \                        p_partkey = ps_partkey\n\
->          \                        and s_suppkey = ps_suppkey\n\
->          \                        and s_nationkey = n_nationkey\n\
->          \                        and n_regionkey = r_regionkey\n\
->          \                        and r_name = 'EUROPE'\n\
->          \        )\n\
->          \order by\n\
->          \        s_acctbal desc,\n\
->          \        n_name,\n\
->          \        s_name,\n\
->          \        p_partkey\n\
->          \fetch first 100 rows only")
->   ,("Q3","\n\
->          \ select\n\
->          \         l_orderkey,\n\
->          \         sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
->          \         o_orderdate,\n\
->          \         o_shippriority\n\
->          \ from\n\
->          \         customer,\n\
->          \         orders,\n\
->          \         lineitem\n\
->          \ where\n\
->          \         c_mktsegment = 'MACHINERY'\n\
->          \         and c_custkey = o_custkey\n\
->          \         and l_orderkey = o_orderkey\n\
->          \         and o_orderdate < date '1995-03-21'\n\
->          \         and l_shipdate > date '1995-03-21'\n\
->          \ group by\n\
->          \         l_orderkey,\n\
->          \         o_orderdate,\n\
->          \         o_shippriority\n\
->          \ order by\n\
->          \         revenue desc,\n\
->          \         o_orderdate\n\
->          \ fetch first 10 rows only")
->   ,("Q4","\n\
->          \ select\n\
->          \         o_orderpriority,\n\
->          \         count(*) as order_count\n\
->          \ from\n\
->          \         orders\n\
->          \ where\n\
->          \         o_orderdate >= date '1996-03-01'\n\
->          \         and o_orderdate < date '1996-03-01' + interval '3' month\n\
->          \         and exists (\n\
->          \                 select\n\
->          \                         *\n\
->          \                 from\n\
->          \                         lineitem\n\
->          \                 where\n\
->          \                         l_orderkey = o_orderkey\n\
->          \                         and l_commitdate < l_receiptdate\n\
->          \         )\n\
->          \ group by\n\
->          \         o_orderpriority\n\
->          \ order by\n\
->          \         o_orderpriority")
->   ,("Q5","\n\
->          \ select\n\
->          \         n_name,\n\
->          \         sum(l_extendedprice * (1 - l_discount)) as revenue\n\
->          \ from\n\
->          \         customer,\n\
->          \         orders,\n\
->          \         lineitem,\n\
->          \         supplier,\n\
->          \         nation,\n\
->          \         region\n\
->          \ where\n\
->          \         c_custkey = o_custkey\n\
->          \         and l_orderkey = o_orderkey\n\
->          \         and l_suppkey = s_suppkey\n\
->          \         and c_nationkey = s_nationkey\n\
->          \         and s_nationkey = n_nationkey\n\
->          \         and n_regionkey = r_regionkey\n\
->          \         and r_name = 'EUROPE'\n\
->          \         and o_orderdate >= date '1997-01-01'\n\
->          \         and o_orderdate < date '1997-01-01' + interval '1' year\n\
->          \ group by\n\
->          \         n_name\n\
->          \ order by\n\
->          \         revenue desc")
->   ,("Q6","\n\
->          \ select\n\
->          \         sum(l_extendedprice * l_discount) as revenue\n\
->          \ from\n\
->          \         lineitem\n\
->          \ where\n\
->          \         l_shipdate >= date '1997-01-01'\n\
->          \         and l_shipdate < date '1997-01-01' + interval '1' year\n\
->          \         and l_discount between 0.07 - 0.01 and 0.07 + 0.01\n\
->          \         and l_quantity < 24")
->   ,("Q7","\n\
->          \ select\n\
->          \         supp_nation,\n\
->          \         cust_nation,\n\
->          \         l_year,\n\
->          \         sum(volume) as revenue\n\
->          \ from\n\
->          \         (\n\
->          \                 select\n\
->          \                         n1.n_name as supp_nation,\n\
->          \                         n2.n_name as cust_nation,\n\
->          \                         extract(year from l_shipdate) as l_year,\n\
->          \                         l_extendedprice * (1 - l_discount) as volume\n\
->          \                 from\n\
->          \                         supplier,\n\
->          \                         lineitem,\n\
->          \                         orders,\n\
->          \                         customer,\n\
->          \                         nation n1,\n\
->          \                         nation n2\n\
->          \                 where\n\
->          \                         s_suppkey = l_suppkey\n\
->          \                         and o_orderkey = l_orderkey\n\
->          \                         and c_custkey = o_custkey\n\
->          \                         and s_nationkey = n1.n_nationkey\n\
->          \                         and c_nationkey = n2.n_nationkey\n\
->          \                         and (\n\
->          \                                 (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')\n\
->          \                                 or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')\n\
->          \                         )\n\
->          \                         and l_shipdate between date '1995-01-01' and date '1996-12-31'\n\
->          \         ) as shipping\n\
->          \ group by\n\
->          \         supp_nation,\n\
->          \         cust_nation,\n\
->          \         l_year\n\
->          \ order by\n\
->          \         supp_nation,\n\
->          \         cust_nation,\n\
->          \         l_year")
->   ,("Q8","\n\
->          \ select\n\
->          \         o_year,\n\
->          \         sum(case\n\
->          \                 when nation = 'IRAQ' then volume\n\
->          \                 else 0\n\
->          \         end) / sum(volume) as mkt_share\n\
->          \ from\n\
->          \         (\n\
->          \                 select\n\
->          \                         extract(year from o_orderdate) as o_year,\n\
->          \                         l_extendedprice * (1 - l_discount) as volume,\n\
->          \                         n2.n_name as nation\n\
->          \                 from\n\
->          \                         part,\n\
->          \                         supplier,\n\
->          \                         lineitem,\n\
->          \                         orders,\n\
->          \                         customer,\n\
->          \                         nation n1,\n\
->          \                         nation n2,\n\
->          \                         region\n\
->          \                 where\n\
->          \                         p_partkey = l_partkey\n\
->          \                         and s_suppkey = l_suppkey\n\
->          \                         and l_orderkey = o_orderkey\n\
->          \                         and o_custkey = c_custkey\n\
->          \                         and c_nationkey = n1.n_nationkey\n\
->          \                         and n1.n_regionkey = r_regionkey\n\
->          \                         and r_name = 'MIDDLE EAST'\n\
->          \                         and s_nationkey = n2.n_nationkey\n\
->          \                         and o_orderdate between date '1995-01-01' and date '1996-12-31'\n\
->          \                         and p_type = 'STANDARD ANODIZED BRASS'\n\
->          \         ) as all_nations\n\
->          \ group by\n\
->          \         o_year\n\
->          \ order by\n\
->          \         o_year")
->    ,("Q9","\n\
->          \ select\n\
->          \         nation,\n\
->          \         o_year,\n\
->          \         sum(amount) as sum_profit\n\
->          \ from\n\
->          \         (\n\
->          \                 select\n\
->          \                         n_name as nation,\n\
->          \                         extract(year from o_orderdate) as o_year,\n\
->          \                         l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount\n\
->          \                 from\n\
->          \                         part,\n\
->          \                         supplier,\n\
->          \                         lineitem,\n\
->          \                         partsupp,\n\
->          \                         orders,\n\
->          \                         nation\n\
->          \                 where\n\
->          \                         s_suppkey = l_suppkey\n\
->          \                         and ps_suppkey = l_suppkey\n\
->          \                         and ps_partkey = l_partkey\n\
->          \                         and p_partkey = l_partkey\n\
->          \                         and o_orderkey = l_orderkey\n\
->          \                         and s_nationkey = n_nationkey\n\
->          \                         and p_name like '%antique%'\n\
->          \         ) as profit\n\
->          \ group by\n\
->          \         nation,\n\
->          \         o_year\n\
->          \ order by\n\
->          \         nation,\n\
->          \         o_year desc")
->    ,("Q10","\n\
->          \ select\n\
->          \         c_custkey,\n\
->          \         c_name,\n\
->          \         sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
->          \         c_acctbal,\n\
->          \         n_name,\n\
->          \         c_address,\n\
->          \         c_phone,\n\
->          \         c_comment\n\
->          \ from\n\
->          \         customer,\n\
->          \         orders,\n\
->          \         lineitem,\n\
->          \         nation\n\
->          \ where\n\
->          \         c_custkey = o_custkey\n\
->          \         and l_orderkey = o_orderkey\n\
->          \         and o_orderdate >= date '1993-12-01'\n\
->          \         and o_orderdate < date '1993-12-01' + interval '3' month\n\
->          \         and l_returnflag = 'R'\n\
->          \         and c_nationkey = n_nationkey\n\
->          \ group by\n\
->          \         c_custkey,\n\
->          \         c_name,\n\
->          \         c_acctbal,\n\
->          \         c_phone,\n\
->          \         n_name,\n\
->          \         c_address,\n\
->          \         c_comment\n\
->          \ order by\n\
->          \         revenue desc\n\
->          \ fetch first 20 rows only")
->    ,("Q11","\n\
->          \ select\n\
->          \         ps_partkey,\n\
->          \         sum(ps_supplycost * ps_availqty) as value\n\
->          \ from\n\
->          \         partsupp,\n\
->          \         supplier,\n\
->          \         nation\n\
->          \ where\n\
->          \         ps_suppkey = s_suppkey\n\
->          \         and s_nationkey = n_nationkey\n\
->          \         and n_name = 'CHINA'\n\
->          \ group by\n\
->          \         ps_partkey having\n\
->          \                 sum(ps_supplycost * ps_availqty) > (\n\
->          \                         select\n\
->          \                                 sum(ps_supplycost * ps_availqty) * 0.0001000000\n\
->          \                         from\n\
->          \                                 partsupp,\n\
->          \                                 supplier,\n\
->          \                                 nation\n\
->          \                         where\n\
->          \                                 ps_suppkey = s_suppkey\n\
->          \                                 and s_nationkey = n_nationkey\n\
->          \                                 and n_name = 'CHINA'\n\
->          \                 )\n\
->          \ order by\n\
->          \         value desc")
->    ,("Q12","\n\
->          \ select\n\
->          \         l_shipmode,\n\
->          \         sum(case\n\
->          \                 when o_orderpriority = '1-URGENT'\n\
->          \                         or o_orderpriority = '2-HIGH'\n\
->          \                         then 1\n\
->          \                 else 0\n\
->          \         end) as high_line_count,\n\
->          \         sum(case\n\
->          \                 when o_orderpriority <> '1-URGENT'\n\
->          \                         and o_orderpriority <> '2-HIGH'\n\
->          \                         then 1\n\
->          \                 else 0\n\
->          \         end) as low_line_count\n\
->          \ from\n\
->          \         orders,\n\
->          \         lineitem\n\
->          \ where\n\
->          \         o_orderkey = l_orderkey\n\
->          \         and l_shipmode in ('AIR', 'RAIL')\n\
->          \         and l_commitdate < l_receiptdate\n\
->          \         and l_shipdate < l_commitdate\n\
->          \         and l_receiptdate >= date '1994-01-01'\n\
->          \         and l_receiptdate < date '1994-01-01' + interval '1' year\n\
->          \ group by\n\
->          \         l_shipmode\n\
->          \ order by\n\
->          \         l_shipmode")
->    ,("Q13","\n\
->          \ select\n\
->          \         c_count,\n\
->          \         count(*) as custdist\n\
->          \ from\n\
->          \         (\n\
->          \                 select\n\
->          \                         c_custkey,\n\
->          \                         count(o_orderkey)\n\
->          \                 from\n\
->          \                         customer left outer join orders on\n\
->          \                                 c_custkey = o_custkey\n\
->          \                                 and o_comment not like '%pending%requests%'\n\
->          \                 group by\n\
->          \                         c_custkey\n\
->          \         ) as c_orders (c_custkey, c_count)\n\
->          \ group by\n\
->          \         c_count\n\
->          \ order by\n\
->          \         custdist desc,\n\
->          \         c_count desc")
->    ,("Q14","\n\
->          \ select\n\
->          \         100.00 * sum(case\n\
->          \                 when p_type like 'PROMO%'\n\
->          \                         then l_extendedprice * (1 - l_discount)\n\
->          \                 else 0\n\
->          \         end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue\n\
->          \ from\n\
->          \         lineitem,\n\
->          \         part\n\
->          \ where\n\
->          \         l_partkey = p_partkey\n\
->          \         and l_shipdate >= date '1994-12-01'\n\
->          \         and l_shipdate < date '1994-12-01' + interval '1' month")
->    ,("Q15","\n\
->          \ /*create view revenue0 (supplier_no, total_revenue) as\n\
->          \         select\n\
->          \                 l_suppkey,\n\
->          \                 sum(l_extendedprice * (1 - l_discount))\n\
->          \         from\n\
->          \                 lineitem\n\
->          \         where\n\
->          \                 l_shipdate >= date '1995-06-01'\n\
->          \                 and l_shipdate < date '1995-06-01' + interval '3' month\n\
->          \         group by\n\
->          \                 l_suppkey;*/\n\
->          \ with\n\
->          \ revenue0 as\n\
->          \         (select\n\
->          \                 l_suppkey as supplier_no,\n\
->          \                 sum(l_extendedprice * (1 - l_discount)) as total_revenue\n\
->          \         from\n\
->          \                 lineitem\n\
->          \         where\n\
->          \                 l_shipdate >= date '1995-06-01'\n\
->          \                 and l_shipdate < date '1995-06-01' + interval '3' month\n\
->          \         group by\n\
->          \                 l_suppkey)\n\
->          \ select\n\
->          \         s_suppkey,\n\
->          \         s_name,\n\
->          \         s_address,\n\
->          \         s_phone,\n\
->          \         total_revenue\n\
->          \ from\n\
->          \         supplier,\n\
->          \         revenue0\n\
->          \ where\n\
->          \         s_suppkey = supplier_no\n\
->          \         and total_revenue = (\n\
->          \                 select\n\
->          \                         max(total_revenue)\n\
->          \                 from\n\
->          \                         revenue0\n\
->          \         )\n\
->          \ order by\n\
->          \         s_suppkey")
->    ,("Q16","\n\
->          \ select\n\
->          \         p_brand,\n\
->          \         p_type,\n\
->          \         p_size,\n\
->          \         count(distinct ps_suppkey) as supplier_cnt\n\
->          \ from\n\
->          \         partsupp,\n\
->          \         part\n\
->          \ where\n\
->          \         p_partkey = ps_partkey\n\
->          \         and p_brand <> 'Brand#15'\n\
->          \         and p_type not like 'MEDIUM BURNISHED%'\n\
->          \         and p_size in (39, 26, 18, 45, 19, 1, 3, 9)\n\
->          \         and ps_suppkey not in (\n\
->          \                 select\n\
->          \                         s_suppkey\n\
->          \                 from\n\
->          \                         supplier\n\
->          \                 where\n\
->          \                         s_comment like '%Customer%Complaints%'\n\
->          \         )\n\
->          \ group by\n\
->          \         p_brand,\n\
->          \         p_type,\n\
->          \         p_size\n\
->          \ order by\n\
->          \         supplier_cnt desc,\n\
->          \         p_brand,\n\
->          \         p_type,\n\
->          \         p_size")
->    ,("Q17","\n\
->          \ select\n\
->          \         sum(l_extendedprice) / 7.0 as avg_yearly\n\
->          \ from\n\
->          \         lineitem,\n\
->          \         part\n\
->          \ where\n\
->          \         p_partkey = l_partkey\n\
->          \         and p_brand = 'Brand#52'\n\
->          \         and p_container = 'JUMBO CAN'\n\
->          \         and l_quantity < (\n\
->          \                 select\n\
->          \                         0.2 * avg(l_quantity)\n\
->          \                 from\n\
->          \                         lineitem\n\
->          \                 where\n\
->          \                         l_partkey = p_partkey\n\
->          \         )")
->    ,("Q18","\n\
->          \ select\n\
->          \         c_name,\n\
->          \         c_custkey,\n\
->          \         o_orderkey,\n\
->          \         o_orderdate,\n\
->          \         o_totalprice,\n\
->          \         sum(l_quantity)\n\
->          \ from\n\
->          \         customer,\n\
->          \         orders,\n\
->          \         lineitem\n\
->          \ where\n\
->          \         o_orderkey in (\n\
->          \                 select\n\
->          \                         l_orderkey\n\
->          \                 from\n\
->          \                         lineitem\n\
->          \                 group by\n\
->          \                         l_orderkey having\n\
->          \                                 sum(l_quantity) > 313\n\
->          \         )\n\
->          \         and c_custkey = o_custkey\n\
->          \         and o_orderkey = l_orderkey\n\
->          \ group by\n\
->          \         c_name,\n\
->          \         c_custkey,\n\
->          \         o_orderkey,\n\
->          \         o_orderdate,\n\
->          \         o_totalprice\n\
->          \ order by\n\
->          \         o_totalprice desc,\n\
->          \         o_orderdate\n\
->          \ fetch first 100 rows only")
->    ,("Q19","\n\
->          \ select\n\
->          \         sum(l_extendedprice* (1 - l_discount)) as revenue\n\
->          \ from\n\
->          \         lineitem,\n\
->          \         part\n\
->          \ where\n\
->          \         (\n\
->          \                 p_partkey = l_partkey\n\
->          \                 and p_brand = 'Brand#43'\n\
->          \                 and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')\n\
->          \                 and l_quantity >= 3 and l_quantity <= 3 + 10\n\
->          \                 and p_size between 1 and 5\n\
->          \                 and l_shipmode in ('AIR', 'AIR REG')\n\
->          \                 and l_shipinstruct = 'DELIVER IN PERSON'\n\
->          \         )\n\
->          \         or\n\
->          \         (\n\
->          \                 p_partkey = l_partkey\n\
->          \                 and p_brand = 'Brand#25'\n\
->          \                 and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')\n\
->          \                 and l_quantity >= 10 and l_quantity <= 10 + 10\n\
->          \                 and p_size between 1 and 10\n\
->          \                 and l_shipmode in ('AIR', 'AIR REG')\n\
->          \                 and l_shipinstruct = 'DELIVER IN PERSON'\n\
->          \         )\n\
->          \         or\n\
->          \         (\n\
->          \                 p_partkey = l_partkey\n\
->          \                 and p_brand = 'Brand#24'\n\
->          \                 and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')\n\
->          \                 and l_quantity >= 22 and l_quantity <= 22 + 10\n\
->          \                 and p_size between 1 and 15\n\
->          \                 and l_shipmode in ('AIR', 'AIR REG')\n\
->          \                 and l_shipinstruct = 'DELIVER IN PERSON'\n\
->          \         )")
->    ,("Q20","\n\
->          \ select\n\
->          \         s_name,\n\
->          \         s_address\n\
->          \ from\n\
->          \         supplier,\n\
->          \         nation\n\
->          \ where\n\
->          \         s_suppkey in (\n\
->          \                 select\n\
->          \                         ps_suppkey\n\
->          \                 from\n\
->          \                         partsupp\n\
->          \                 where\n\
->          \                         ps_partkey in (\n\
->          \                                 select\n\
->          \                                         p_partkey\n\
->          \                                 from\n\
->          \                                         part\n\
->          \                                 where\n\
->          \                                         p_name like 'lime%'\n\
->          \                         )\n\
->          \                         and ps_availqty > (\n\
->          \                                 select\n\
->          \                                         0.5 * sum(l_quantity)\n\
->          \                                 from\n\
->          \                                         lineitem\n\
->          \                                 where\n\
->          \                                         l_partkey = ps_partkey\n\
->          \                                         and l_suppkey = ps_suppkey\n\
->          \                                         and l_shipdate >= date '1994-01-01'\n\
->          \                                         and l_shipdate < date '1994-01-01' + interval '1' year\n\
->          \                         )\n\
->          \         )\n\
->          \         and s_nationkey = n_nationkey\n\
->          \         and n_name = 'VIETNAM'\n\
->          \ order by\n\
->          \         s_name")
->    ,("Q21","\n\
->          \ select\n\
->          \         s_name,\n\
->          \         count(*) as numwait\n\
->          \ from\n\
->          \         supplier,\n\
->          \         lineitem l1,\n\
->          \         orders,\n\
->          \         nation\n\
->          \ where\n\
->          \         s_suppkey = l1.l_suppkey\n\
->          \         and o_orderkey = l1.l_orderkey\n\
->          \         and o_orderstatus = 'F'\n\
->          \         and l1.l_receiptdate > l1.l_commitdate\n\
->          \         and exists (\n\
->          \                 select\n\
->          \                         *\n\
->          \                 from\n\
->          \                         lineitem l2\n\
->          \                 where\n\
->          \                         l2.l_orderkey = l1.l_orderkey\n\
->          \                         and l2.l_suppkey <> l1.l_suppkey\n\
->          \         )\n\
->          \         and not exists (\n\
->          \                 select\n\
->          \                         *\n\
->          \                 from\n\
->          \                         lineitem l3\n\
->          \                 where\n\
->          \                         l3.l_orderkey = l1.l_orderkey\n\
->          \                         and l3.l_suppkey <> l1.l_suppkey\n\
->          \                         and l3.l_receiptdate > l3.l_commitdate\n\
->          \         )\n\
->          \         and s_nationkey = n_nationkey\n\
->          \         and n_name = 'INDIA'\n\
->          \ group by\n\
->          \         s_name\n\
->          \ order by\n\
->          \         numwait desc,\n\
->          \         s_name\n\
->          \ fetch first 100 rows only")
->    ,("Q22","\n\
->          \ select\n\
->          \         cntrycode,\n\
->          \         count(*) as numcust,\n\
->          \         sum(c_acctbal) as totacctbal\n\
->          \ from\n\
->          \         (\n\
->          \                 select\n\
->          \                         substring(c_phone from 1 for 2) as cntrycode,\n\
->          \                         c_acctbal\n\
->          \                 from\n\
->          \                         customer\n\
->          \                 where\n\
->          \                         substring(c_phone from 1 for 2) in\n\
->          \                                 ('41', '28', '39', '21', '24', '29', '44')\n\
->          \                         and c_acctbal > (\n\
->          \                                 select\n\
->          \                                         avg(c_acctbal)\n\
->          \                                 from\n\
->          \                                         customer\n\
->          \                                 where\n\
->          \                                         c_acctbal > 0.00\n\
->          \                                         and substring(c_phone from 1 for 2) in\n\
->          \                                                 ('41', '28', '39', '21', '24', '29', '44')\n\
->          \                         )\n\
->          \                         and not exists (\n\
->          \                                 select\n\
->          \                                         *\n\
->          \                                 from\n\
->          \                                         orders\n\
->          \                                 where\n\
->          \                                         o_custkey = c_custkey\n\
->          \                         )\n\
->          \         ) as custsale\n\
->          \ group by\n\
->          \         cntrycode\n\
->          \ order by\n\
->          \         cntrycode")
->   ]