X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Test%2FTime%2FFormat%2FHTTP.hs;fp=Test%2FTime%2FFormat%2FHTTP.hs;h=67cdfc1bebaaccfb5153ff739f67e85bea794d8d;hp=b443e86919a0dd2dce09579a61e28c9d82e2b453;hb=daca86c87e52ed787d06306952f27a3d386e3a76;hpb=15c5ee0bee3b42f0e60cd96e5cd0ae7d1696f7a8

diff --git a/Test/Time/Format/HTTP.hs b/Test/Time/Format/HTTP.hs
index b443e86..67cdfc1 100644
--- 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