1
Fork 0

few small fixes

untested fix for case insensitive keywords
add partial support for interval literals
fix bug in prefix operator cast parsing
This commit is contained in:
Jake Wheat 2013-12-14 00:07:45 +02:00
parent 9c4719bda3
commit f08f4eb13b
5 changed files with 27 additions and 13 deletions

View file

@ -14,6 +14,7 @@
> import qualified Language.Haskell.Exts.Fixity as HSE > import qualified Language.Haskell.Exts.Fixity as HSE
> import Data.Maybe > import Data.Maybe
> import Data.List > import Data.List
> import Data.Char
> import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Syntax
@ -112,9 +113,15 @@ digitse[+-]digits
> i <- int > i <- int
> return (p ++ "e" ++ s ++ i) > return (p ++ "e" ++ s ++ i)
> interval :: P ScalarExpr
> interval = try (keyword_ "interval") >>
> IntervalLit
> <$> stringLiteral
> <*> identifierString
> <*> optionMaybe (try $ parens (read <$> many1 digit))
> literal :: P ScalarExpr > literal :: P ScalarExpr
> literal = number <|> estring > literal = number <|> estring <|> interval
> identifierString :: P String > identifierString :: P String
> identifierString = do > identifierString = do
@ -242,9 +249,9 @@ to be.
> typeName :: P TypeName > typeName :: P TypeName
> typeName = choice > typeName = choice
> [TypeName "double precision" > [TypeName "double precision"
> <$ keyword_ "double" <* keyword_ "precision" > <$ try (keyword_ "double" <* keyword_ "precision")
> ,TypeName "character varying" > ,TypeName "character varying"
> <$ keyword_ "character" <* keyword_ "varying" > <$ try (keyword_ "character" <* keyword_ "varying")
> ,TypeName <$> identifierString] > ,TypeName <$> identifierString]
> binOpSymbolNames :: [String] > binOpSymbolNames :: [String]
@ -579,7 +586,7 @@ attempt to fix the precedence and associativity. Doesn't work
> symbol_ s = symbol s *> return () > symbol_ s = symbol s *> return ()
> keyword :: String -> P String > keyword :: String -> P String
> keyword s = string s > keyword s = ((map toLower) <$> string s)
> <* notFollowedBy (char '_' <|> alphaNum) > <* notFollowedBy (char '_' <|> alphaNum)
> <* whiteSpace > <* whiteSpace

View file

@ -23,6 +23,10 @@ back into SQL source text. It attempts to format the output nicely.
> scalarExpr :: ScalarExpr -> Doc > scalarExpr :: ScalarExpr -> Doc
> scalarExpr (StringLit s) = quotes $ text s > scalarExpr (StringLit s) = quotes $ text s
> scalarExpr (NumLit s) = text s > scalarExpr (NumLit s) = text s
> scalarExpr (IntervalLit v u p) =
> text "interval" <+> quotes (text v)
> <+> text u
> <+> maybe empty (parens . text . show ) p
> scalarExpr (Iden i) = text i > scalarExpr (Iden i) = text i
> scalarExpr (Iden2 q i) = text q <> text "." <> text i > scalarExpr (Iden2 q i) = text q <> text "." <> text i
> scalarExpr Star = text "*" > scalarExpr Star = text "*"

View file

@ -18,6 +18,9 @@
> data ScalarExpr = NumLit String > data ScalarExpr = NumLit String
> | StringLit String > | StringLit String
> | IntervalLit String -- text of interval
> String -- units of interval
> (Maybe Int) -- precision
> | Iden String > | Iden String
> | Iden2 String String > | Iden2 String String
> | Star > | Star

7
TODO
View file

@ -3,7 +3,7 @@
first release: first release:
complete the parsing for the tests in the Tests.lhs complete the parsing for the tests in the Tests.lhs
case insensivity case insensivity DONE?
get tpch parsing get tpch parsing
check the pretty printer on the tpch queries check the pretty printer on the tpch queries
add automated tests to cabal add automated tests to cabal
@ -20,7 +20,7 @@ dialect switching
refactor the join parsing refactor the join parsing
left factor parsing code left factor parsing code in remaining places
reimplement the fixity thing natively reimplement the fixity thing natively
@ -31,8 +31,6 @@ position annotation
= sql support = sql support
case insensitivity
scalar function syntax: scalar function syntax:
standard interval literal standard interval literal
@ -54,7 +52,6 @@ escapes in string literals
full number literals -> other bases? full number literals -> other bases?
group by (), grouping sets(), cube, rollup group by (), grouping sets(), cube, rollup
lateral lateral
corresponding
named windows named windows
table, values table, values
cte cte

View file

@ -42,6 +42,8 @@
> ,("3e-3", NumLit "3e-3") > ,("3e-3", NumLit "3e-3")
> ,("'string'", StringLit "string") > ,("'string'", StringLit "string")
> ,("'1'", StringLit "1") > ,("'1'", StringLit "1")
> ,("interval '3' day", IntervalLit "3" "day" Nothing)
> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3)
> ] > ]
> identifiers :: TestItem > identifiers :: TestItem
@ -413,14 +415,15 @@
> tpchTests :: TestItem > tpchTests :: TestItem
> tpchTests = > tpchTests =
> Group "parse tpch" > Group "parse tpch"
> $ map (ParseQueryExpr . snd) tpchQueries > $ map (ParseQueryExpr . snd)
> $ take 1 tpchQueries
> testData :: TestItem > testData :: TestItem
> testData = > testData =
> Group "parserTest" > Group "parserTest"
> [scalarExprParserTests > [scalarExprParserTests
> ,queryExprParserTests > ,queryExprParserTests
> --,tpchTests > ,tpchTests
> ] > ]