From c29176f08e76d245196976e6ae67a21179668c0c Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Fri, 13 Dec 2013 14:08:33 +0200 Subject: [PATCH] add TODO, tests and some small fixes add TODO add a bunch of tests fix issue where 'order by' was being confused with the 'or' operator due to bad lexing fix missing ctor in parens scalar expr parser rename parens scalar parser to sparens and betweenParens helper to parrens export the makeSelect from the syntax module --- .gitignore | 1 + Parser.lhs | 52 +++++++----- Syntax.lhs | 1 + TODO | 68 ++++++++++++++++ Tests.lhs | 227 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 325 insertions(+), 24 deletions(-) create mode 100644 TODO diff --git a/.gitignore b/.gitignore index 178135c..4d3c086 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ /dist/ +/logchanges \ No newline at end of file diff --git a/Parser.lhs b/Parser.lhs index 5bc16ce..f67104f 100644 --- a/Parser.lhs +++ b/Parser.lhs @@ -1,6 +1,8 @@ -> module Parser (parseQueryExpr, parseScalarExpr) where +> module Parser (parseQueryExpr +> ,parseScalarExpr +> ,ParseError(..)) where > import Text.Groom > import Text.Parsec @@ -48,9 +50,10 @@ > where > letterOrUnderscore = char '_' <|> letter > letterDigitOrUnderscore = char '_' <|> alphaNum -> blacklist = ["as", "from", "where", "having", "group", "order" +> blacklist :: [String] +> blacklist = ["as", "from", "where", "having", "group", "order" > ,"inner", "left", "right", "full", "natural", "join" -> ,"on", "using", "when", "then", "case", "end"] +> ,"on", "using", "when", "then", "case", "end", "order"] TODO: talk about what must be in the blacklist, and what doesn't need to be. @@ -68,7 +71,7 @@ to be. > app :: P ScalarExpr -> app = App <$> identifierString <*> betweenParens (commaSep scalarExpr') +> app = App <$> identifierString <*> parens (commaSep scalarExpr') > scase :: P ScalarExpr > scase = @@ -80,12 +83,14 @@ to be. > swhen = keyword_ "when" *> > ((,) <$> scalarExpr' <*> (keyword_ "then" *> scalarExpr')) -> binOpNames :: [String] -> binOpNames = ["=", "<=", ">=" -> ,"!=", "<>", "<", ">" -> ,"and", "or" -> ,"*", "/", "+", "-" -> ,"||", "like"] +> binOpSymbolNames :: [String] +> binOpSymbolNames = ["=", "<=", ">=" +> ,"!=", "<>", "<", ">" +> ,"*", "/", "+", "-" +> ,"||"] + +> binOpKeywordNames :: [String] +> binOpKeywordNames = ["and", "or", "like"] > unaryOp :: P ScalarExpr > unaryOp = makeOp <$> (try (keyword_ "not") *> scalarExpr) @@ -100,14 +105,15 @@ to be. > ,try app > ,try dottedIdentifier > ,identifier -> ,parens] +> ,sparens] > trysuffix e = try (suffix e) <|> return e > suffix e0 = (makeOp e0 <$> opSymbol <*> factor) >>= trysuffix -> opSymbol = choice (map (try . symbol) binOpNames) +> opSymbol = choice (map (try . symbol) binOpSymbolNames +> ++ map (try . keyword) binOpKeywordNames) > makeOp e0 op e1 = Op op [e0,e1] -> parens :: P ScalarExpr -> parens = betweenParens scalarExpr' +> sparens :: P ScalarExpr +> sparens = Parens <$> parens scalarExpr' > toHaskell :: ScalarExpr -> HSE.Exp > toHaskell e = case e of @@ -188,8 +194,8 @@ to be. > from :: P [TableRef] > from = option [] (try (keyword_ "from") *> commaSep1 tref) > where -> tref = choice [try (JoinQueryExpr <$> betweenParens queryExpr) -> ,JoinParens <$> betweenParens tref +> tref = choice [try (JoinQueryExpr <$> parens queryExpr) +> ,JoinParens <$> parens tref > ,SimpleTableRef <$> identifierString] > >>= optionSuffix join > >>= optionSuffix alias @@ -218,7 +224,7 @@ to be. > joinExpr = choice > [(Just . JoinUsing) > <$> (try (keyword_ "using") -> *> betweenParens (commaSep1 identifierString)) +> *> parens (commaSep1 identifierString)) > ,(Just . JoinOn) <$> (try (keyword_ "on") *> scalarExpr) > ,return Nothing > ] @@ -275,21 +281,25 @@ to be. > optionSuffix :: (a -> P a) -> a -> P a > optionSuffix p a = option a (p a) -> betweenParens :: P a -> P a -> betweenParens = between (symbol_ "(") (symbol_ ")") +> parens :: P a -> P a +> parens = between (symbol_ "(") (symbol_ ")") > commaSep :: P a -> P [a] > commaSep = (`sepBy` symbol_ ",") > symbol :: String -> P String -> symbol s = string s <* whiteSpace +> symbol s = string s +> -- <* notFollowedBy (oneOf "+-/*<>=!|") +> <* whiteSpace > symbol_ :: String -> P () > symbol_ s = symbol s *> return () > keyword :: String -> P String -> keyword s = string s <* whiteSpace +> keyword s = string s +> <* notFollowedBy (char '_' <|> alphaNum) +> <* whiteSpace > keyword_ :: String -> P () > keyword_ s = keyword s *> return () diff --git a/Syntax.lhs b/Syntax.lhs index d0f4287..1db345d 100644 --- a/Syntax.lhs +++ b/Syntax.lhs @@ -1,5 +1,6 @@ > module Syntax (QueryExpr(..) +> ,makeSelect > ,ScalarExpr(..) > ,TableRef(..) > ,JoinType(..) diff --git a/TODO b/TODO new file mode 100644 index 0000000..f311c09 --- /dev/null +++ b/TODO @@ -0,0 +1,68 @@ +add tests + +left factor parsing code + +implement pretty printer + +reimplement the fixity thing natively + +dialect switching + +fix lexing wrt suffixes + +position annotation + +emacs parse error formatting + += sql support + +count(*) +decimal literals, split string and number literals +order by directions +distinct/all +limit,offset, top + +scalar function syntax: + aggregate app + window app + cast + exists, in subquery + scalar subquery + in list + any/some/all + between + is null/ is not null + review all ansi sql operators + interval literal + typed string lit? + placeholder/positional arg + +other missing operators + unary + - + row constructors? + extract + substring + +except, intersect, union + + +review identifiers +order by nulls first/last +extend case +more dots in identifiers +escapes in string literals +full number literals +quoted identifiers +group by (), grouping sets(), cube, rollup +lateral +corresponding +named windows +cte +apply, pivot +full tableref aliases +collate + +within group aggregate syntax +try to do full review of sql2003 query syntax + +maybe later: other dml \ No newline at end of file diff --git a/Tests.lhs b/Tests.lhs index 92edae6..c77f2d2 100644 --- a/Tests.lhs +++ b/Tests.lhs @@ -1,9 +1,11 @@ -> module Tests where +> module Tests (testData) where > import Syntax > import Pretty > import Parser +> import qualified Test.HUnit as H +> import Control.Monad > data TestItem = Group String [TestItem] > | TestScalarExpr String ScalarExpr @@ -11,13 +13,232 @@ > deriving (Eq,Show) > scalarExprParserTests :: TestItem -> scalarExprParserTests = Group "scalarExprParserTests" [] +> scalarExprParserTests = Group "scalarExprParserTests" +> [literals +> ,identifiers +> ,star +> ,app +> ,caseexp +> ,operators +> ,parens +> ] + +> literals :: TestItem +> literals = Group "literals" $ map (uncurry TestScalarExpr) +> [("3", Literal "3") +> ,("'string'", Literal "string") +> ] + +> identifiers :: TestItem +> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr) +> [("iden1", Identifier "iden1") +> ,("t.a", Identifier2 "t" "a") +> ] + +> star :: TestItem +> star = Group "star" $ map (uncurry TestScalarExpr) +> [("*", Star) +> ,("t.*", Star2 "t") +> ] + +> app :: TestItem +> app = Group "app" $ map (uncurry TestScalarExpr) +> [("f()", App "f" []) +> ,("f(a)", App "f" [Identifier "a"]) +> ,("f(a,b)", App "f" [Identifier "a", Identifier "b"]) +> ] + +> caseexp :: TestItem +> caseexp = Group "caseexp" $ map (uncurry TestScalarExpr) +> [("case a when 1 then 2 end" +> ,Case (Just $ Identifier "a") [(Literal "1", Literal "2")] Nothing) +> ,("case a when 1 then 2 when 3 then 4 end" +> ,Case (Just $ Identifier "a") [(Literal "1", Literal "2") +> ,(Literal "3", Literal "4")] Nothing) +> ,("case a when 1 then 2 when 3 then 4 else 5 end" +> ,Case (Just $ Identifier "a") [(Literal "1", Literal "2") +> ,(Literal "3", Literal "4")] (Just $ Literal "5")) +> ,("case when a=1 then 2 when a=3 then 4 else 5 end" +> ,Case Nothing [(Op "=" [Identifier "a", Literal "1"], Literal "2") +> ,(Op "=" [Identifier "a", Literal "3"], Literal "4")] +> (Just $ Literal "5")) +> ] + +> operators :: TestItem +> operators = Group "operators" $ map (uncurry TestScalarExpr) +> [("a + b", Op "+" [Identifier "a", Identifier "b"]) +> ,("not not a", Op "not" [Op "not" [Identifier "a"]]) +> ] + +> parens :: TestItem +> parens = Group "parens" $ map (uncurry TestScalarExpr) +> [("(a)", Parens (Identifier "a")) +> ,("(a + b)", Parens (Op "+" [Identifier "a", Identifier "b"])) +> ] > queryExprParserTests :: TestItem -> queryExprParserTests = Group "queryExprParserTests" [] +> queryExprParserTests = Group "queryExprParserTests" +> [selectLists +> ,from +> ,whereClause +> ,groupByClause +> ,having +> ,orderBy +> ,fullQueries +> ] + +> selectLists :: TestItem +> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr) +> [("select 1", +> makeSelect {qeSelectList = [(Nothing,Literal "1")]}) +> ,("select a" +> ,makeSelect {qeSelectList = [(Nothing,Identifier "a")]}) +> ,("select a,b" +> ,makeSelect {qeSelectList = [(Nothing,Identifier "a") +> ,(Nothing,Identifier "b")]}) +> ,("select 1+2,3+4" +> ,makeSelect {qeSelectList = +> [(Nothing,Op "+" [Literal "1",Literal "2"]) +> ,(Nothing,Op "+" [Literal "3",Literal "4"])]}) +> ,("select a as a, /*comment*/ b as b" +> ,makeSelect {qeSelectList = [(Just "a", Identifier "a") +> ,(Just "b", Identifier "b")]}) +> ,("select a a, b b" +> ,makeSelect {qeSelectList = [(Just "a", Identifier "a") +> ,(Just "b", Identifier "b")]}) +> ] + +> from :: TestItem +> from = Group "from" $ map (uncurry TestQueryExpr) +> [("select a from t" +> ,ms [SimpleTableRef "t"]) +> ,("select a from t,u" +> ,ms [SimpleTableRef "t", SimpleTableRef "u"]) +> ,("select a from t inner join u on expr" +> ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u") +> (Just $ JoinOn $ Identifier "expr")]) +> ,("select a from t left join u on expr" +> ,ms [JoinTableRef JLeft (SimpleTableRef "t") (SimpleTableRef "u") +> (Just $ JoinOn $ Identifier "expr")]) +> ,("select a from t right join u on expr" +> ,ms [JoinTableRef JRight (SimpleTableRef "t") (SimpleTableRef "u") +> (Just $ JoinOn $ Identifier "expr")]) +> ,("select a from t full join u on expr" +> ,ms [JoinTableRef Full (SimpleTableRef "t") (SimpleTableRef "u") +> (Just $ JoinOn $ Identifier "expr")]) +> ,("select a from t cross join u" +> ,ms [JoinTableRef Cross (SimpleTableRef "t") +> (SimpleTableRef "u") Nothing]) +> ,("select a from t natural inner join u" +> ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u") +> (Just JoinNatural)]) +> ,("select a from t inner join u using(a,b)" +> ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u") +> (Just $ JoinUsing ["a", "b"])]) +> ,("select a from (select a from t)" +> ,ms [JoinQueryExpr $ ms [SimpleTableRef "t"]]) +> ,("select a from t as u" +> ,ms [JoinAlias (SimpleTableRef "t") "u"]) +> ,("select a from t u" +> ,ms [JoinAlias (SimpleTableRef "t") "u"]) +> ,("select a from (t cross join u) as u" +> ,ms [JoinAlias (JoinParens $ JoinTableRef Cross (SimpleTableRef "t") +> (SimpleTableRef "u") Nothing) "u"]) +> ] +> where +> ms f = makeSelect {qeSelectList = [(Nothing,Identifier "a")] +> ,qeFrom = f} + +> whereClause :: TestItem +> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) +> [("select a from t where a = 5" +> ,makeSelect {qeSelectList = [(Nothing,Identifier "a")] +> ,qeFrom = [SimpleTableRef "t"] +> ,qeWhere = Just $ Op "=" [Identifier "a", Literal "5"]}) +> ] + +> groupByClause :: TestItem +> groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr) +> [("select a,sum(b) from t group by a" +> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") +> ,(Nothing, App "sum" [Identifier "b"])] +> ,qeFrom = [SimpleTableRef "t"] +> ,qeGroupBy = [Identifier "a"] +> }) +> ,("select a,b,sum(c) from t group by a,b" +> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") +> ,(Nothing, Identifier "b") +> ,(Nothing, App "sum" [Identifier "c"])] +> ,qeFrom = [SimpleTableRef "t"] +> ,qeGroupBy = [Identifier "a",Identifier "b"] +> }) +> ] + +> having :: TestItem +> having = Group "having" $ map (uncurry TestQueryExpr) +> [("select a,sum(b) from t group by a having sum(b) > 5" +> ,makeSelect {qeSelectList = [(Nothing, Identifier "a") +> ,(Nothing, App "sum" [Identifier "b"])] +> ,qeFrom = [SimpleTableRef "t"] +> ,qeGroupBy = [Identifier "a"] +> ,qeHaving = Just $ Op ">" [App "sum" [Identifier "b"], Literal "5"] +> }) +> ] + +> orderBy :: TestItem +> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr) +> [("select a from t order by a" +> ,ms [Identifier "a"]) +> ,("select a from t order by a, b" +> ,ms [Identifier "a", Identifier "b"]) +> ] +> where +> ms o = makeSelect {qeSelectList = [(Nothing,Identifier "a")] +> ,qeFrom = [SimpleTableRef "t"] +> ,qeOrderBy = o} + +> fullQueries :: TestItem +> fullQueries = Group "queries" $ map (uncurry TestQueryExpr) +> [("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 = [(Nothing, Identifier "a") +> ,(Just "s", App "sum" [Op "+" [Identifier "c" +> ,Identifier "d"]])] +> ,qeFrom = [SimpleTableRef "t", SimpleTableRef "u"] +> ,qeWhere = Just $ Op ">" [Identifier "a", Literal "5"] +> ,qeGroupBy = [Identifier "a"] +> ,qeHaving = Just $ Op ">" [App "count" [Literal "1"] +> ,Literal "5"] +> ,qeOrderBy = [Identifier "s"] +> } +> ) +> ] > testData :: TestItem > testData = > Group "parserTest" > [scalarExprParserTests > ,queryExprParserTests] + + +> runTests :: IO () +> runTests = void $ H.runTestTT $ itemToTest testData + +> itemToTest :: TestItem -> H.Test +> itemToTest (Group nm ts) = +> H.TestLabel nm $ H.TestList $ map itemToTest ts +> itemToTest (TestScalarExpr str expected) = +> toTest parseScalarExpr str expected +> itemToTest (TestQueryExpr str expected) = +> toTest parseQueryExpr str expected + +> toTest parser str expected = H.TestLabel str $ H.TestCase $ do +> let egot = parser "" Nothing str +> case egot of +> Left e -> H.assertFailure $ show e +> Right got -> H.assertEqual "" expected got