X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Test%2FTime%2FHTTP.hs;h=7ef3210af7d0a49390bf1859613bf76be50ad443;hp=0cf15d83736fa40d5f22620a88b84a0385702660;hb=782e6a9;hpb=0d92b15f2616ce900da624e983973aebe7bc7583 diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs index 0cf15d8..7ef3210 100644 --- a/Test/Time/HTTP.hs +++ b/Test/Time/HTTP.hs @@ -5,10 +5,14 @@ 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 qualified Data.Time.Asctime as Asctime +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 @@ -60,22 +64,28 @@ instance Arbitrary UTCTime where tests ∷ [Property] tests = [ -- Asctime - property ( Asctime.fromAscii "Sun Nov 6 08:49:37 1994" - ≡ Right referenceLocalTime ) + property ( fromAttempt (ca (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged Asctime Ascii)) + ≡ Just referenceLocalTime + ) - , property ( "Sun Nov 6 08:49:37 1994" - ≡ Asctime.toAscii referenceLocalTime ) + , property ( (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged Asctime Ascii) + ≡ cs referenceLocalTime + ) - , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt) + , 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" @@ -88,8 +98,8 @@ tests = [ -- Asctime -- HTTP , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii ut ) - , property $ \ut → Right ut ≡ HTTP.fromAscii (Asctime.toAscii (ut2lt ut)) - , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii (ut2zt ut)) + , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii)) + , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC733 Ascii)) , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut)) ] where