diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 867dd6f..5773051 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -14,6 +14,7 @@ > import qualified Language.Haskell.Exts.Fixity as HSE > import Data.Maybe > import Data.List +> import Data.Char > import Language.SQL.SimpleSQL.Syntax @@ -112,9 +113,15 @@ digitse[+-]digits > i <- int > 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 = number <|> estring +> literal = number <|> estring <|> interval > identifierString :: P String > identifierString = do @@ -242,9 +249,9 @@ to be. > typeName :: P TypeName > typeName = choice > [TypeName "double precision" -> <$ keyword_ "double" <* keyword_ "precision" +> <$ try (keyword_ "double" <* keyword_ "precision") > ,TypeName "character varying" -> <$ keyword_ "character" <* keyword_ "varying" +> <$ try (keyword_ "character" <* keyword_ "varying") > ,TypeName <$> identifierString] > binOpSymbolNames :: [String] @@ -579,7 +586,7 @@ attempt to fix the precedence and associativity. Doesn't work > symbol_ s = symbol s *> return () > keyword :: String -> P String -> keyword s = string s +> keyword s = ((map toLower) <$> string s) > <* notFollowedBy (char '_' <|> alphaNum) > <* whiteSpace diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 38412ab..e799761 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -23,6 +23,10 @@ back into SQL source text. It attempts to format the output nicely. > scalarExpr :: ScalarExpr -> Doc > scalarExpr (StringLit s) = quotes $ 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 (Iden2 q i) = text q <> text "." <> text i > scalarExpr Star = text "*" diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index f86d232..f7246a3 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -18,6 +18,9 @@ > data ScalarExpr = NumLit String > | StringLit String +> | IntervalLit String -- text of interval +> String -- units of interval +> (Maybe Int) -- precision > | Iden String > | Iden2 String String > | Star diff --git a/TODO b/TODO index 0284504..96b32f2 100644 --- a/TODO +++ b/TODO @@ -3,7 +3,7 @@ first release: complete the parsing for the tests in the Tests.lhs -case insensivity +case insensivity DONE? get tpch parsing check the pretty printer on the tpch queries add automated tests to cabal @@ -20,7 +20,7 @@ dialect switching refactor the join parsing -left factor parsing code +left factor parsing code in remaining places reimplement the fixity thing natively @@ -31,8 +31,6 @@ position annotation = sql support -case insensitivity - scalar function syntax: standard interval literal @@ -54,7 +52,6 @@ escapes in string literals full number literals -> other bases? group by (), grouping sets(), cube, rollup lateral -corresponding named windows table, values cte diff --git a/Tests.lhs b/Tests.lhs index 04059d2..579b65b 100644 --- a/Tests.lhs +++ b/Tests.lhs @@ -40,8 +40,10 @@ > ,("3e3", NumLit "3e3") > ,("3e+3", NumLit "3e+3") > ,("3e-3", NumLit "3e-3") -> ,("'string'", StringLit "string") -> ,("'1'", StringLit "1") +> ,("'string'", StringLit "string") +> ,("'1'", StringLit "1") +> ,("interval '3' day", IntervalLit "3" "day" Nothing) +> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3) > ] > identifiers :: TestItem @@ -413,14 +415,15 @@ > tpchTests :: TestItem > tpchTests = > Group "parse tpch" -> $ map (ParseQueryExpr . snd) tpchQueries +> $ map (ParseQueryExpr . snd) +> $ take 1 tpchQueries > testData :: TestItem > testData = > Group "parserTest" > [scalarExprParserTests > ,queryExprParserTests -> --,tpchTests +> ,tpchTests > ]