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 b443e86919a0dd2dce09579a61e28c9d82e2b453..67cdfc1bebaaccfb5153ff739f67e85bea794d8d 100644 (file)
--- a/Test/Time/Format/HTTP.hs
+++ b/Test/Time/Format/HTTP.hs
@@ -115,11 +115,13 @@ tests = [ -- Asctime
                      ≡ Just referenceZonedTime
                    )
 
                      ≡ 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))
 
           -- 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 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
         , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii)))
         ]
     where