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]

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:

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
 

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