X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Test%2FTime%2FHTTP.hs;h=7ef3210af7d0a49390bf1859613bf76be50ad443;hp=2f7225e15eaf2fe1e35d8eff196c0579c3917c32;hb=782e6a9;hpb=55924ce19f25b6bdbeea1c507dc3b00bc5bf84bc diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs index 2f7225e..7ef3210 100644 --- 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 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 qualified Data.Time.RFC733 as RFC733 +import Data.Time.RFC733 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 - 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 ) - , property $ \lt → lt ≡ convertUnsafe ( cs (lt ∷ LocalTime) - ∷ Tagged Asctime Ascii - ) + , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) + ∷ Tagged Asctime Ascii)) -- 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" @@ -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)) - , 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