5 module Main (main) where
6 import Control.Applicative
7 import Control.Applicative.Unicode
8 import Data.Ascii (Ascii)
9 import Data.Attempt hiding (Failure, Success)
10 import Data.Convertible.Base
13 import Data.Time.Asctime
14 import qualified Data.Time.HTTP as HTTP
15 import Data.Time.RFC733
16 import Data.Time.RFC1123
18 import Prelude.Unicode
19 import Test.QuickCheck
22 main = mapM_ runTest tests
24 runTest ∷ Property → IO ()
26 = do r ← quickCheckResult prop
28 Success {} → return ()
29 GaveUp {} → exitFailure
30 Failure {} → exitFailure
31 NoExpectedFailure {} → exitFailure
33 instance Arbitrary Day where
34 arbitrary = ModifiedJulianDay <$> arbitrary
36 instance Arbitrary TimeOfDay where
38 = do h ← choose (0, 23)
41 return $ TimeOfDay h m (fromIntegral (s ∷ Int))
43 instance Arbitrary LocalTime where
44 arbitrary = LocalTime <$> arbitrary ⊛ arbitrary
46 instance Eq ZonedTime where
47 a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b
49 instance Arbitrary TimeZone where
51 = do m ← choose (-1439, 1439)
54 return $ TimeZone m s n
56 instance Arbitrary ZonedTime where
57 arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary
59 instance Arbitrary DiffTime where
60 arbitrary = secondsToDiffTime <$> choose (0, 86400)
62 instance Arbitrary UTCTime where
63 arbitrary = UTCTime <$> arbitrary ⊛ arbitrary
67 property ( fromAttempt (ca (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged Asctime Ascii))
68 ≡ Just referenceLocalTime
71 , property ( (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged Asctime Ascii)
72 ≡ cs referenceLocalTime
75 , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime)
76 ∷ Tagged Asctime Ascii))
79 , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii))
80 ≡ Just referenceZonedTime
83 , property ( (Tagged "Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Tagged RFC733 Ascii)
84 ≡ cs referenceZonedTime
87 , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime)
88 ∷ Tagged RFC733 Ascii))
91 , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii))
92 ≡ Just referenceZonedTime
95 , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii)
96 ≡ cs referenceZonedTime
99 , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime)
100 ∷ Tagged RFC1123 Ascii))
103 , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii ut )
104 , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii))
105 , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC733 Ascii))
106 , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii))
110 = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)
113 = ZonedTime referenceLocalTime utc
115 ut2lt = utcToLocalTime utc
117 ut2zt = utcToZonedTime utc