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
This commit is contained in:
Jake Wheat
parent
5ae8dbcf2c
commit
c29176f08e
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -1 +1,2 @@
|
|||
/dist/
|
||||
/logchanges
|
||||
52
Parser.lhs
52
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 ()
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
|
||||
> module Syntax (QueryExpr(..)
|
||||
> ,makeSelect
|
||||
> ,ScalarExpr(..)
|
||||
> ,TableRef(..)
|
||||
> ,JoinType(..)
|
||||
|
|
|
|||
68
TODO
Normal file
68
TODO
Normal file
|
|
@ -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
|
||||
227
Tests.lhs
227
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue