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

[time-http.git] / Test / Time / Format / HTTP.hs

diff --git a/Test/Time/Format/HTTP.hs b/Test/Time/Format/HTTP.hs
index 6555cdbbd01d18c49626c1cdfcf2d9ddb2297370..67cdfc1bebaaccfb5153ff739f67e85bea794d8d 100644 (file)
--- a/Test/Time/Format/HTTP.hs
+++ b/Test/Time/Format/HTTP.hs
@@ -12,7 +12,7 @@ import Data.Convertible.Base
 import Data.Proxy
 import Data.Tagged
 import Data.Time
-import Data.Time.Format.Asctime
+import Data.Time.Format.C
 import Data.Time.Format.HTTP
 import Data.Time.Format.RFC733
 import Data.Time.Format.RFC822
@@ -89,15 +89,15 @@ instance Arbitrary (Tagged Cent20 UTCTime) where
 
 tests ∷ [Property]
 tests = [ -- Asctime
-          property ( fromAttempt (ca (Tagged "Sun Nov  6 08:49:37 1994" ∷ Tagged Asctime Ascii))
+          property ( fromAttempt (ca (Tagged "Sun Nov  6 08:49:37 1994" ∷ Tagged C Ascii))
                      ≡ Just referenceLocalTime
                    )
 
-        , property ( (Tagged "Sun Nov  6 08:49:37 1994" ∷ Tagged Asctime Ascii)
+        , property ( (Tagged "Sun Nov  6 08:49:37 1994" ∷ Tagged C Ascii)
                      ≡ cs referenceLocalTime
                    )
 
-        , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) ∷ Tagged Asctime Ascii))
+        , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) ∷ Tagged C Ascii))
 
           -- RFC733
         , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii))
@@ -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))
@@ -137,10 +139,13 @@ tests = [ -- Asctime
                      ≡ cs referenceUTCTime
                    )
         , property $ \ut → Just ut ≡ fromAttempt (ca (cs ut ∷ Tagged HTTP Ascii) ∷ Attempt UTCTime)
-        , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2lt ut) ∷ Tagged Asctime Ascii)))
+        , 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