implement complete interval literals
This commit is contained in:
parent
f64632bbac
commit
3b86a06e5c
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
2
TODO
|
@ -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:
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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")
|
||||||
> ]
|
> ]
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue