RFC1123

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

diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs
index 2f7225e15eaf2fe1e35d8eff196c0579c3917c32..3022d0d78c1ef3a95da6fae4d00dff11bf0ff355 100644 (file)
--- a/Test/Time/HTTP.hs
+++ b/Test/Time/HTTP.hs
@@ -6,13 +6,14 @@ 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 qualified Data.Time.RFC1123 as RFC1123
+import Data.Time.RFC733
+import Data.Time.RFC1123

 import System.Exit
 import Prelude.Unicode
 import Test.QuickCheck
 import System.Exit
 import Prelude.Unicode
 import Test.QuickCheck


@@ -63,45 +64,46 @@ 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
 
           -- RFC1123

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

 
 

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

 
 

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

 
           -- 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 (RFC1123.toAscii (ut2zt ut))
+        , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC733  Ascii))
+        , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii))

         ]
     where
       referenceLocalTime
         ]
     where
       referenceLocalTime