From 3b86a06e5c864694dd923959ecb19d882506be90 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Fri, 18 Apr 2014 21:38:24 +0300 Subject: [PATCH] implement complete interval literals --- Language/SQL/SimpleSQL/Parser.lhs | 41 ++++++++++++--------- Language/SQL/SimpleSQL/Pretty.lhs | 26 +++++++------ Language/SQL/SimpleSQL/Syntax.lhs | 7 ++-- TODO | 2 + tools/Language/SQL/SimpleSQL/SQL2003.lhs | 19 ++++++++-- tools/Language/SQL/SimpleSQL/ValueExprs.lhs | 6 ++- 6 files changed, 64 insertions(+), 37 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index bd86899..3c7c04d 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -115,14 +115,16 @@ interval '3 days' which parses as a typed literal > interval :: Parser ValueExpr -> interval = keyword_ "interval" >> -> mkIt <$> stringToken -> <*> optionMaybe -> ((,) <$> identifierBlacklist blacklist -> <*> optionMaybe (parens unsignedInteger)) +> interval = keyword_ "interval" >> do +> s <- optionMaybe $ choice [True <$ symbol_ "+" +> ,False <$ symbol_ "-"] +> lit <- stringToken +> q <- optionMaybe intervalQualifier +> mkIt s lit q > where -> mkIt val Nothing = TypedLit (TypeName [Name "interval"]) val -> mkIt val (Just (a,b)) = IntervalLit val a b +> mkIt Nothing val Nothing = return $ TypedLit (TypeName [Name "interval"]) val +> mkIt s val (Just (a,b)) = return $ IntervalLit s val a b +> mkIt (Just {}) _val Nothing = fail "cannot use sign without interval qualifier" > characterSetLiteral :: Parser ValueExpr > characterSetLiteral = @@ -538,17 +540,8 @@ TODO: this need heavy refactoring > rowField = (,) <$> name <*> typeName > -- interval type names: interval a [to b] > intervalTypeName = -> keyword_ "interval" *> -> choice -> [IntervalTypeName <$> intervalField -> <*> optionMaybe (keyword_ "to" *> intervalField) -> ,return $ TypeName [Name "interval"]] -> intervalField = -> Itf -> <$> identifierBlacklist blacklist -> <*> optionMaybe -> (parens ((,) <$> unsignedInteger -> <*> optionMaybe (comma *> unsignedInteger))) +> keyword_ "interval" >> +> uncurry IntervalTypeName <$> intervalQualifier > -- other type names, which includes: > -- precision, scale, lob scale and units, timezone, character > -- set and collations @@ -627,6 +620,18 @@ TODO: this need heavy refactoring > ,"binary large object" > ] +> intervalQualifier :: Parser (IntervalTypeField,Maybe IntervalTypeField) +> intervalQualifier = +> (,) <$> intervalField +> <*> optionMaybe (keyword_ "to" *> intervalField) +> where +> intervalField = +> Itf +> <$> identifierBlacklist blacklist +> <*> optionMaybe +> (parens ((,) <$> unsignedInteger +> <*> optionMaybe (comma *> unsignedInteger))) + == value expression parens, row ctor and scalar subquery diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 627c9c4..50e9744 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -37,10 +37,12 @@ which have been changed to try to improve the layout of the output. > valueExpr (StringLit s) = quotes $ text $ doubleUpQuotes s > valueExpr (NumLit s) = text s -> valueExpr (IntervalLit v u p) = -> text "interval" <+> quotes (text v) -> <+> text u -> <+> me (parens . text . show ) p +> valueExpr (IntervalLit s v f t) = +> text "interval" +> <+> me (\x -> if x then text "+" else text "-") s +> <+> quotes (text v) +> <+> intervalTypeField f +> <+> me (\x -> text "to" <+> intervalTypeField x) t > valueExpr (Iden i) = names i > valueExpr Star = text "*" > valueExpr Parameter = text "?" @@ -273,13 +275,8 @@ which have been changed to try to improve the layout of the output. > f (n,t) = name n <+> typeName t > typeName (IntervalTypeName f t) = > text "interval" -> <+> it f -> <+> me (\x -> text "to" <+> it x) t -> where -> it (Itf n p) = -> text n -> <+> me (\(x,x1) -> parens (text (show x) -> <+> me (\y -> (sep [comma,text (show y)])) x1)) p +> <+> intervalTypeField f +> <+> me (\x -> text "to" <+> intervalTypeField x) t > typeName (ArrayTypeName tn sz) = > typeName tn <+> text "array" <+> me (brackets . text . show) sz @@ -287,6 +284,13 @@ which have been changed to try to improve the layout of the output. > typeName (MultisetTypeName tn) = > typeName tn <+> text "multiset" +> intervalTypeField :: IntervalTypeField -> Doc +> intervalTypeField (Itf n p) = +> text n +> <+> me (\(x,x1) -> +> parens (text (show x) +> <+> me (\y -> (sep [comma,text (show y)])) x1)) p + = query expressions diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 8150001..a1b3742 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -59,9 +59,10 @@ > -- | text of interval literal, units of interval precision, > -- e.g. interval 3 days (3) > | IntervalLit -> {ilLiteral :: String -- ^ literal text -> ,ilUnits :: String -- ^ units -> ,ilPrecision :: Maybe Integer -- ^ precision +> {ilSign :: Maybe Bool -- ^ true if + used, false if - used +> ,ilLiteral :: String -- ^ literal text +> ,ilFrom :: IntervalTypeField +> ,ilTo :: Maybe IntervalTypeField > } > -- | identifier with parts separated by dots > | Iden [Name] diff --git a/TODO b/TODO index 405b935..2682e28 100644 --- a/TODO +++ b/TODO @@ -30,6 +30,8 @@ decide whether to represent numeric literals better, instead of a refactor the typename parsing +reorder the parser and syntax (and the pretty) + remove the IsString for Name and [Name] fixes: diff --git a/tools/Language/SQL/SimpleSQL/SQL2003.lhs b/tools/Language/SQL/SimpleSQL/SQL2003.lhs index 7965663..320e66b 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2003.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2003.lhs @@ -665,10 +665,23 @@ normal typed literals > intervalLiterals :: TestItem > intervalLiterals = Group "intervalLiterals literals" $ map (uncurry TestValueExpr) -> [ -> ] +> [("interval '1'", TypedLit (TypeName "interval") "1") +> ,("interval '1' day" +> ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing) +> ,("interval '1' day(3)" +> ,IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing) +> ,("interval + '1' day(3)" +> ,IntervalLit (Just True) "1" (Itf "day" $ Just (3,Nothing)) Nothing) +> ,("interval - '1' second(2,2)" +> ,IntervalLit (Just False) "1" (Itf "second" $ Just (2,Just 2)) Nothing) +> ,("interval '1' year to month" +> ,IntervalLit Nothing "1" (Itf "year" Nothing) +> (Just $ Itf "month" Nothing)) -TODO: intervals + more date and time literals +> ,("interval '1' year(4) to second(2,3) " +> ,IntervalLit Nothing "1" (Itf "year" $ Just (4,Nothing)) +> (Just $ Itf "second" $ Just (2, Just 3))) +> ] == boolean literals diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs index bd2feec..9c4dd1b 100644 --- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs @@ -38,8 +38,10 @@ Tests for parsing value expressions > ,("'string'", StringLit "string") > ,("'string with a '' quote'", StringLit "string with a ' quote") > ,("'1'", StringLit "1") -> ,("interval '3' day", IntervalLit "3" "day" Nothing) -> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3) +> ,("interval '3' day" +> ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing) +> ,("interval '3' day (3)" +> ,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing) > ,("interval '3 weeks'", TypedLit (TypeName "interval") "3 weeks") > ]