{-# LANGUAGE 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 () main = mapM_ runTest tests runTest ∷ Property → IO () runTest prop = do r ← quickCheckResult prop case r of Success {} → return () GaveUp {} → exitFailure 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 = [ -- 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