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")
> ]