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