Bump version to 0.4: Don't forget that conversion from ZonedTime to RFC-822 date...

diff --git a/ChangeLog b/ChangeLog
index 8f305ee2d0b1c18fee77c8d29bfd619ca2ceb0fa..86a83798cc4eeb589efe53081f0894f22b9236da 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,5 @@
+== time-http-0.4 / unreleased
+* bugfix: Don't forget that conversion from ZonedTime to RFC-822 date and time can fail, due to its Y2K problem.
 == time-http-0.3 / 2011-12-15
 * Use tagged and convertible
 == time-http-0.2 / 2011-10-03

diff --git a/Data/Time/Format/RFC822/Internal.hs b/Data/Time/Format/RFC822/Internal.hs
index d1f62d2c3b5d330a0bcc6b4430b7e9de8d7eef65..a4c3c22ba49d86506a83fe8d74eb16248f0b2258 100644 (file)
--- a/Data/Time/Format/RFC822/Internal.hs
+++ b/Data/Time/Format/RFC822/Internal.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
-    FlexibleInstances
+    FlexibleContexts
+  , FlexibleInstances
   , MultiParamTypeClasses
   , OverloadedStrings
   , TemplateHaskell
@@ -12,10 +13,12 @@ module Data.Time.Format.RFC822.Internal
     )
     where
 import Control.Applicative
+import Control.Failure
 import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8
 import Data.Convertible.Base
+import Data.Convertible.Utils
 import Data.Monoid.Unicode
 import Data.Tagged
 import Data.Time
@@ -26,17 +29,21 @@ import Prelude.Unicode
 -- |The phantom type for conversions between RFC 822 date and time
 -- strings and 'ZonedTime'.
 --
--- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)
--- Tagged "Sun, 06 Nov 94 08:49:37 GMT"
+-- >>> convertAttempt (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)
+-- Success (Tagged "Sun, 06 Nov 94 08:49:37 GMT")
+--
+-- Note that RFC 822 has a Y2K problem so converting 'ZonedTime' whose
+-- gregorian year is earlier than 1900 or from 2000 onward results in
+-- @'ConvertBoundsException' 'Day' 'ZonedTime'@.
 data RFC822
 
-instance ConvertSuccess ZonedTime (Tagged RFC822 Ascii) where
-    {-# INLINE convertSuccess #-}
-    convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+instance ConvertAttempt ZonedTime (Tagged RFC822 Ascii) where
+    {-# INLINE convertAttempt #-}
+    convertAttempt = ((A.fromAsciiBuilder <$>) <$>) ∘ ca
 
-instance ConvertSuccess ZonedTime (Tagged RFC822 AsciiBuilder) where
-    {-# INLINE convertSuccess #-}
-    convertSuccess = Tagged ∘ toAsciiBuilder
+instance ConvertAttempt ZonedTime (Tagged RFC822 AsciiBuilder) where
+    {-# INLINE convertAttempt #-}
+    convertAttempt = (Tagged <$>) ∘ toAsciiBuilder
 
 instance ConvertSuccess TimeZone (Tagged RFC822 Ascii) where
     {-# INLINE convertSuccess #-}
@@ -120,7 +127,9 @@ zone = choice [ string "UT"  *> return (TimeZone 0 False "UT" )
               , read4digitsTZ
               ]
 
-toAsciiBuilder ∷ ZonedTime → AsciiBuilder
+toAsciiBuilder ∷ Failure (ConvertBoundsException Day ZonedTime) f
+               ⇒ ZonedTime
+               → f AsciiBuilder
 toAsciiBuilder zonedTime
     = let localTime          = zonedTimeToLocalTime zonedTime
           timeZone           = zonedTimeZone zonedTime
@@ -128,24 +137,29 @@ toAsciiBuilder zonedTime
           (_, _, week)       = toWeekDate  (localDay localTime)
           timeOfDay          = localTimeOfDay localTime
       in
-        shortWeekDayName week
-        ⊕ A.toAsciiBuilder ", "
-        ⊕ show2 day
-        ⊕ A.toAsciiBuilder " "
-        ⊕ shortMonthName month
-        ⊕ A.toAsciiBuilder " "
-        ⊕ show2 (year `mod` 100)
-        ⊕ A.toAsciiBuilder " "
-        ⊕ show2 (todHour timeOfDay)
-        ⊕ A.toAsciiBuilder ":"
-        ⊕ show2 (todMin timeOfDay)
-        ⊕ A.toAsciiBuilder ":"
-        ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
-        ⊕ A.toAsciiBuilder " "
-        ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
+        if year < 1900 ∨ year ≥ 2000 then
+            let minDay = fromGregorian 1900  1  1
+                maxDay = fromGregorian 1999 12 31
+            in
+              failure $ ConvertBoundsException minDay maxDay zonedTime
+        else
+            return $
+            shortWeekDayName week
+            ⊕ A.toAsciiBuilder ", "
+            ⊕ show2 day
+            ⊕ A.toAsciiBuilder " "
+            ⊕ shortMonthName month
+            ⊕ A.toAsciiBuilder " "
+            ⊕ show2 (year `mod` 100)
+            ⊕ A.toAsciiBuilder " "
+            ⊕ show2 (todHour timeOfDay)
+            ⊕ A.toAsciiBuilder ":"
+            ⊕ show2 (todMin timeOfDay)
+            ⊕ A.toAsciiBuilder ":"
+            ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
+            ⊕ A.toAsciiBuilder " "
+            ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
 
-deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC822 Ascii        |])
-               , ([t| ZonedTime |], [t| Tagged RFC822 AsciiBuilder |])
-               , ([t| TimeZone  |], [t| Tagged RFC822 Ascii        |])
+deriveAttempts [ ([t| TimeZone  |], [t| Tagged RFC822 Ascii        |])
                , ([t| TimeZone  |], [t| Tagged RFC822 AsciiBuilder |])
                ]

diff --git a/Test/Time/Format/HTTP.hs b/Test/Time/Format/HTTP.hs
index b443e86919a0dd2dce09579a61e28c9d82e2b453..67cdfc1bebaaccfb5153ff739f67e85bea794d8d 100644 (file)
--- a/Test/Time/Format/HTTP.hs
+++ b/Test/Time/Format/HTTP.hs
@@ -115,11 +115,13 @@ tests = [ -- Asctime
                      ≡ Just referenceZonedTime
                    )
 
-        , property ( (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii)
-                     ≡ cs referenceZonedTime
+        , property ( Just (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii)
+                     ≡ fromAttempt (ca referenceZonedTime)
                    )
-        , property $ \zt → Just (untag zt) ≡ fromAttempt (ca (cs (untag (zt ∷ Tagged Cent20 ZonedTime))
-                                                                ∷ Tagged RFC822 Ascii))
+        , property $ \zt → let zt' = do a ← ca $ untag (zt ∷ Tagged Cent20 ZonedTime)
+                                        ca (a ∷ Tagged RFC822 Ascii)
+                           in
+                             fromAttempt zt' ≡ Just (untag zt)
 
           -- RFC1123
         , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii))
@@ -139,8 +141,11 @@ tests = [ -- Asctime
         , property $ \ut → Just ut ≡ fromAttempt (ca (cs ut ∷ Tagged HTTP Ascii) ∷ Attempt UTCTime)
         , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2lt ut) ∷ Tagged C Ascii)))
         , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC733 Ascii)))
-        , property $ \ut → Just (untag ut) ≡ fromAttempt (ca (retagHTTP (cs (ut2zt (untag (ut ∷ Tagged Cent20 UTCTime)))
-                                                                           ∷ Tagged RFC822 Ascii)))
+        , property $ \ut → let zt  = ut2zt $ untag (ut ∷ Tagged Cent20 UTCTime)
+                               ut' = do a ← ca zt
+                                        ca $ retagHTTP (a ∷ Tagged RFC822 Ascii)
+                           in
+                             fromAttempt ut' ≡ Just (untag ut)
         , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii)))
         ]
     where

diff --git a/bugs/issue-d8873d7c8927894257a438b5f02752d3ba702f66.yaml b/bugs/issue-d8873d7c8927894257a438b5f02752d3ba702f66.yaml
new file mode 100644 (file)
index 0000000..455210f
--- /dev/null
+++ b/bugs/issue-d8873d7c8927894257a438b5f02752d3ba702f66.yaml
@@ -0,0 +1,27 @@
+--- !ditz.rubyforge.org,2008-03-06/issue 
+title: Don't forget that conversion from ZonedTime to RFC-822 date and time can fail, due to its Y2K problem.
+desc: Make it ConvertAttempt, not ConvertSuccess.
+type: :bugfix
+component: time-http
+release: time-http-0.4
+reporter: PHO <pho@cielonegro.org>
+status: :closed
+disposition: :fixed
+creation_time: 2011-12-16 13:11:18.237158 Z
+references: []
+
+id: d8873d7c8927894257a438b5f02752d3ba702f66
+log_events: 
+- - 2011-12-16 13:11:24.381526 Z
+  - PHO <pho@cielonegro.org>
+  - created
+  - Done.
+- - 2011-12-16 13:11:53.887803 Z
+  - PHO <pho@cielonegro.org>
+  - assigned to release time-http-0.4 from unassigned
+  - ""
+- - 2011-12-16 13:12:10.385138 Z
+  - PHO <pho@cielonegro.org>
+  - closed with disposition fixed
+  - ""
+git_branch: 

diff --git a/bugs/project.yaml b/bugs/project.yaml
index 2b11e712493c5c2d0321e97ae2ee73c84c3832b1..b6d34458951d91df5c0d2f3ce3290527a87900a8 100644 (file)
--- a/bugs/project.yaml
+++ b/bugs/project.yaml
@@ -31,3 +31,12 @@ releases:
     - PHO <pho@cielonegro.org>
     - released
     - Done, but I'm not so confident with my own changes...
+- !ditz.rubyforge.org,2008-03-06/release 
+  name: time-http-0.4
+  status: :unreleased
+  release_time: 
+  log_events: 
+  - - 2011-12-16 13:11:37.518764 Z
+    - PHO <pho@cielonegro.org>
+    - created
+    - ""

diff --git a/time-http.cabal b/time-http.cabal
index d30a68a90e325199c4be99c43ea4e95d129a3284..5f0cc632bb556c8780d5ecd623c229c0e98713d4 100644 (file)
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -1,5 +1,5 @@
 Name:                time-http
-Version:             0.3
+Version:             0.4
 Synopsis:            Parse and format HTTP/1.1 Date and Time strings
 Description:
         This package provides functionalities to parse and format
@@ -40,13 +40,14 @@ Library
     Build-depends:
         ascii                == 0.0.*,
         attempt              == 0.3.*,
-        attoparsec           == 0.9.*,
+        attoparsec           == 0.10.*,
         base                 == 4.*,
         base-unicode-symbols == 0.2.*,
         blaze-builder        == 0.3.*,
         blaze-textual        == 0.2.*,
         bytestring           == 0.9.*,
         convertible-text     == 0.4.*,
+        failure              == 0.1.*,
         tagged               == 0.2.*,
         time                 == 1.2.*
 
@@ -64,13 +65,14 @@ Test-Suite test-time-http
         QuickCheck           == 2.4.*,
         ascii                == 0.0.*,
         attempt              == 0.3.*,
-        attoparsec           == 0.9.*,
+        attoparsec           == 0.10.*,
         base                 == 4.*,
         base-unicode-symbols == 0.2.*,
         blaze-builder        == 0.3.*,
         blaze-textual        == 0.2.*,
         bytestring           == 0.9.*,
         convertible-text     == 0.4.*,
+        failure              == 0.1.*,
         tagged               == 0.2.*,
         time                 == 1.2.*
     GHC-Options: