Rewrote RFC733

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

diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs
index 2f7225e15eaf2fe1e35d8eff196c0579c3917c32..7ef3210af7d0a49390bf1859613bf76be50ad443 100644 (file)
--- a/Test/Time/HTTP.hs
+++ b/Test/Time/HTTP.hs
@@ -6,12 +6,13 @@ module Main (main) where
 import Control.Applicative
 import Control.Applicative.Unicode
 import Data.Ascii (Ascii)
 import Control.Applicative
 import Control.Applicative.Unicode
 import Data.Ascii (Ascii)

+import Data.Attempt hiding (Failure, Success)

 import Data.Convertible.Base
 import Data.Tagged
 import Data.Time
 import Data.Time.Asctime
 import qualified Data.Time.HTTP    as HTTP
 import Data.Convertible.Base
 import Data.Tagged
 import Data.Time
 import Data.Time.Asctime
 import qualified Data.Time.HTTP    as HTTP

-import qualified Data.Time.RFC733  as RFC733
+import Data.Time.RFC733

 import qualified Data.Time.RFC1123 as RFC1123
 import System.Exit
 import Prelude.Unicode
 import qualified Data.Time.RFC1123 as RFC1123
 import System.Exit
 import Prelude.Unicode


@@ -63,30 +64,28 @@ instance Arbitrary UTCTime where
 
 tests ∷ [Property]
 tests = [ -- Asctime
 
 tests ∷ [Property]
 tests = [ -- Asctime

-          property ( convertUnsafe ( Tagged "Sun Nov  6 08:49:37 1994"
-                                     ∷ Tagged Asctime Ascii
-                                   )
-                     ≡ referenceLocalTime
+          property ( fromAttempt (ca (Tagged "Sun Nov  6 08:49:37 1994" ∷ Tagged Asctime 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 Asctime Ascii)

                      ≡ cs referenceLocalTime
                    )
 
                      ≡ cs referenceLocalTime
                    )
 

-        , property $ \lt → lt ≡ convertUnsafe ( cs (lt ∷ LocalTime)
-                                                ∷ Tagged Asctime Ascii
-                                              )
+        , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime)
+                                                        ∷ Tagged Asctime Ascii))

 
           -- RFC733
 
           -- RFC733

-        , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT"
-                     ≡ Right referenceZonedTime )
+        , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii))
+                     ≡ Just referenceZonedTime
+                   )

 
 

-        , property ( "Sunday, 06-Nov-1994 08:49:37 GMT"
-                     ≡ RFC733.toAscii referenceZonedTime )
+        , property ( (Tagged "Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Tagged RFC733 Ascii)
+                     ≡ cs referenceZonedTime
+                   )

 
 

-        , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt)
+        , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime)
+                                                        ∷ Tagged RFC733 Ascii))

 
           -- RFC1123
         , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"
 
           -- RFC1123
         , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"


@@ -100,7 +99,7 @@ tests = [ -- Asctime
           -- HTTP
         , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii           ut )
         , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii))
           -- HTTP
         , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii           ut )
         , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii))

-        , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii  (ut2zt ut))
+        , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC733  Ascii))

         , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut))
         ]
     where
         , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut))
         ]
     where