implement complete interval literals

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
 

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
 

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]