X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Test%2FTime%2FHTTP.hs;h=2f7225e15eaf2fe1e35d8eff196c0579c3917c32;hp=97c5da85f429b954ed5ae4b74c831dac48212779;hb=127b8db;hpb=1029ed1724795d960c3117be35380d3a9c92c6ed diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs index 97c5da8..2f7225e 100644 --- a/Test/Time/HTTP.hs +++ b/Test/Time/HTTP.hs @@ -1,8 +1,20 @@ {-# LANGUAGE - UnicodeSyntax + OverloadedStrings + , UnicodeSyntax #-} module Main (main) where +import Control.Applicative +import Control.Applicative.Unicode +import Data.Ascii (Ascii) +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 System.Exit +import Prelude.Unicode import Test.QuickCheck main ∷ IO () @@ -17,6 +29,87 @@ 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 ( convertUnsafe ( Tagged "Sun Nov 6 08:49:37 1994" + ∷ Tagged Asctime Ascii + ) + ≡ referenceLocalTime + ) + + , property ( ( Tagged "Sun Nov 6 08:49:37 1994" + ∷ Tagged Asctime Ascii + ) + ≡ cs referenceLocalTime + ) + + , property $ \lt → lt ≡ convertUnsafe ( cs (lt ∷ LocalTime) + ∷ Tagged Asctime Ascii + ) + + -- 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 (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)) ] + where + referenceLocalTime + = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37) + + referenceZonedTime + = ZonedTime referenceLocalTime utc + + ut2lt = utcToLocalTime utc + + ut2zt = utcToZonedTime utc