1
Fork 0

implement complete interval literals

This commit is contained in:
Jake Wheat 2014-04-18 21:38:24 +03:00
parent f64632bbac
commit 3b86a06e5c
6 changed files with 64 additions and 37 deletions

View file

@ -115,14 +115,16 @@ interval '3 days'
which parses as a typed literal which parses as a typed literal
> interval :: Parser ValueExpr > interval :: Parser ValueExpr
> interval = keyword_ "interval" >> > interval = keyword_ "interval" >> do
> mkIt <$> stringToken > s <- optionMaybe $ choice [True <$ symbol_ "+"
> <*> optionMaybe > ,False <$ symbol_ "-"]
> ((,) <$> identifierBlacklist blacklist > lit <- stringToken
> <*> optionMaybe (parens unsignedInteger)) > q <- optionMaybe intervalQualifier
> mkIt s lit q
> where > where
> mkIt val Nothing = TypedLit (TypeName [Name "interval"]) val > mkIt Nothing val Nothing = return $ TypedLit (TypeName [Name "interval"]) val
> mkIt val (Just (a,b)) = IntervalLit val a b > 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 :: Parser ValueExpr
> characterSetLiteral = > characterSetLiteral =
@ -538,17 +540,8 @@ TODO: this need heavy refactoring
> rowField = (,) <$> name <*> typeName > rowField = (,) <$> name <*> typeName
> -- interval type names: interval a [to b] > -- interval type names: interval a [to b]
> intervalTypeName = > intervalTypeName =
> keyword_ "interval" *> > keyword_ "interval" >>
> choice > uncurry IntervalTypeName <$> intervalQualifier
> [IntervalTypeName <$> intervalField
> <*> optionMaybe (keyword_ "to" *> intervalField)
> ,return $ TypeName [Name "interval"]]
> intervalField =
> Itf
> <$> identifierBlacklist blacklist
> <*> optionMaybe
> (parens ((,) <$> unsignedInteger
> <*> optionMaybe (comma *> unsignedInteger)))
> -- other type names, which includes: > -- other type names, which includes:
> -- precision, scale, lob scale and units, timezone, character > -- precision, scale, lob scale and units, timezone, character
> -- set and collations > -- set and collations
@ -627,6 +620,18 @@ TODO: this need heavy refactoring
> ,"binary large object" > ,"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 == value expression parens, row ctor and scalar subquery

View file

@ -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 (StringLit s) = quotes $ text $ doubleUpQuotes s
> valueExpr (NumLit s) = text s > valueExpr (NumLit s) = text s
> valueExpr (IntervalLit v u p) = > valueExpr (IntervalLit s v f t) =
> text "interval" <+> quotes (text v) > text "interval"
> <+> text u > <+> me (\x -> if x then text "+" else text "-") s
> <+> me (parens . text . show ) p > <+> quotes (text v)
> <+> intervalTypeField f
> <+> me (\x -> text "to" <+> intervalTypeField x) t
> valueExpr (Iden i) = names i > valueExpr (Iden i) = names i
> valueExpr Star = text "*" > valueExpr Star = text "*"
> valueExpr Parameter = 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 > f (n,t) = name n <+> typeName t
> typeName (IntervalTypeName f t) = > typeName (IntervalTypeName f t) =
> text "interval" > text "interval"
> <+> it f > <+> intervalTypeField f
> <+> me (\x -> text "to" <+> it x) t > <+> me (\x -> text "to" <+> intervalTypeField 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
> typeName (ArrayTypeName tn sz) = > typeName (ArrayTypeName tn sz) =
> typeName tn <+> text "array" <+> me (brackets . text . show) 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 (MultisetTypeName tn) =
> typeName tn <+> text "multiset" > 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 = query expressions

View file

@ -59,9 +59,10 @@
> -- | text of interval literal, units of interval precision, > -- | text of interval literal, units of interval precision,
> -- e.g. interval 3 days (3) > -- e.g. interval 3 days (3)
> | IntervalLit > | IntervalLit
> {ilLiteral :: String -- ^ literal text > {ilSign :: Maybe Bool -- ^ true if + used, false if - used
> ,ilUnits :: String -- ^ units > ,ilLiteral :: String -- ^ literal text
> ,ilPrecision :: Maybe Integer -- ^ precision > ,ilFrom :: IntervalTypeField
> ,ilTo :: Maybe IntervalTypeField
> } > }
> -- | identifier with parts separated by dots > -- | identifier with parts separated by dots
> | Iden [Name] > | Iden [Name]

2
TODO
View file

@ -30,6 +30,8 @@ decide whether to represent numeric literals better, instead of a
refactor the typename parsing refactor the typename parsing
reorder the parser and syntax (and the pretty)
remove the IsString for Name and [Name] remove the IsString for Name and [Name]
fixes: fixes:

View file

@ -665,10 +665,23 @@ normal typed literals
> intervalLiterals :: TestItem > intervalLiterals :: TestItem
> intervalLiterals = Group "intervalLiterals literals" $ map (uncurry TestValueExpr) > 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 == boolean literals

View file

@ -38,8 +38,10 @@ Tests for parsing value expressions
> ,("'string'", StringLit "string") > ,("'string'", StringLit "string")
> ,("'string with a '' quote'", StringLit "string with a ' quote") > ,("'string with a '' quote'", StringLit "string with a ' quote")
> ,("'1'", StringLit "1") > ,("'1'", StringLit "1")
> ,("interval '3' day", IntervalLit "3" "day" Nothing) > ,("interval '3' day"
> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3) > ,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") > ,("interval '3 weeks'", TypedLit (TypeName "interval") "3 weeks")
> ] > ]