X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Test%2FTime%2FHTTP.hs;h=f0f9bfb3dedbb7eee3dc9ec95566c8c5b0469b23;hp=97c5da85f429b954ed5ae4b74c831dac48212779;hb=fec6c14;hpb=1029ed1724795d960c3117be35380d3a9c92c6ed diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs index 97c5da8..f0f9bfb 100644 --- a/Test/Time/HTTP.hs +++ b/Test/Time/HTTP.hs @@ -1,8 +1,18 @@ {-# LANGUAGE - UnicodeSyntax + OverloadedStrings + , UnicodeSyntax + , ViewPatterns #-} module Main (main) where +import Control.Applicative +import Control.Applicative.Unicode +import Data.Time +import qualified Data.Time.Asctime as Asctime +import qualified Data.Time.HTTP as HTTP +import qualified Data.Time.RFC733 as RFC733 +import qualified Data.Time.RFC1123 as RFC1123 import System.Exit +import Prelude.Unicode import Test.QuickCheck main ∷ IO () @@ -17,6 +27,79 @@ runTest prop Failure {} → exitFailure NoExpectedFailure {} → exitFailure +instance Arbitrary Day where + arbitrary = ModifiedJulianDay <$> arbitrary + +instance Arbitrary TimeOfDay where + arbitrary + = do h ← choose (0, 23) + m ← choose (0, 59) + s ← choose (0, 60) + return $ TimeOfDay h m (fromIntegral (s ∷ Int)) + +instance Arbitrary LocalTime where + arbitrary = LocalTime <$> arbitrary ⊛ arbitrary + +instance Eq ZonedTime where + a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b + +instance Arbitrary TimeZone where + arbitrary + = do m ← choose (-1439, 1439) + s ← arbitrary + n ← arbitrary + return $ TimeZone m s n + +instance Arbitrary ZonedTime where + arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary + +instance Arbitrary DiffTime where + arbitrary = secondsToDiffTime <$> choose (0, 86400) + +instance Arbitrary UTCTime where + arbitrary = UTCTime <$> arbitrary ⊛ arbitrary + tests ∷ [Property] -tests = [ +tests = [ -- Asctime + property ( Asctime.fromAscii "Sun Nov 6 08:49:37 1994" + ≡ Right referenceLocalTime ) + + , property ( "Sun Nov 6 08:49:37 1994" + ≡ Asctime.toAscii referenceLocalTime ) + + , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt) + + -- RFC733 + , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT" + ≡ Right referenceZonedTime ) + + , property ( "Sunday, 06-Nov-1994 08:49:37 GMT" + ≡ RFC733.toAscii referenceZonedTime ) + + , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt) + + -- RFC1123 + , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT" + ≡ Right referenceZonedTime ) + + , property ( "Sun, 06 Nov 1994 08:49:37 GMT" + ≡ RFC1123.toAscii referenceZonedTime ) + + , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt) + + -- 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 (RFC1123.toAscii (ut2zt ut)) ] + where + referenceLocalTime + = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37) + + referenceZonedTime + = ZonedTime referenceLocalTime utc + + ut2lt = utcToLocalTime utc + + ut2zt = utcToZonedTime utc