6 module Main (main) where
7 import Control.Applicative
8 import Control.Applicative.Unicode
9 import Data.Ascii (Ascii)
10 import Data.Attempt hiding (Failure, Success)
11 import Data.Convertible.Base
15 import Data.Time.Format.C
16 import Data.Time.Format.HTTP
17 import Data.Time.Format.RFC733
18 import Data.Time.Format.RFC822
19 import Data.Time.Format.RFC1123
21 import Prelude.Unicode
22 import Test.QuickCheck
25 main = mapM_ runTest tests
27 runTest ∷ Property → IO ()
29 = do r ← quickCheckResult prop
31 Success {} → return ()
32 GaveUp {} → exitFailure
33 Failure {} → exitFailure
34 NoExpectedFailure {} → exitFailure
41 instance Arbitrary Day where
42 arbitrary = ModifiedJulianDay <$> arbitrary
44 instance Arbitrary (Tagged Cent20 Day) where
45 arbitrary = ((Tagged ∘) ∘) ∘ fromGregorian
46 <$> choose (1900, 1999)
50 instance Arbitrary TimeOfDay where
52 = do h ← choose (0, 23)
55 return $ TimeOfDay h m (fromIntegral (s ∷ Int))
57 instance Arbitrary LocalTime where
58 arbitrary = LocalTime <$> arbitrary ⊛ arbitrary
60 instance Arbitrary (Tagged Cent20 LocalTime) where
61 arbitrary = (Tagged ∘) ∘ LocalTime <$>
62 (flip proxy cent20 <$> arbitrary)
65 instance Eq ZonedTime where
66 a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b
68 instance Arbitrary TimeZone where
70 = do m ← choose (-1439, 1439)
73 return $ TimeZone m s n
75 instance Arbitrary ZonedTime where
76 arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary
78 instance Arbitrary (Tagged Cent20 ZonedTime) where
79 arbitrary = (Tagged ∘) ∘ ZonedTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary
81 instance Arbitrary DiffTime where
82 arbitrary = secondsToDiffTime <$> choose (0, 86400)
84 instance Arbitrary UTCTime where
85 arbitrary = UTCTime <$> arbitrary ⊛ arbitrary
87 instance Arbitrary (Tagged Cent20 UTCTime) where
88 arbitrary = (Tagged ∘) ∘ UTCTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary
92 property ( fromAttempt (ca (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged C Ascii))
93 ≡ Just referenceLocalTime
96 , property ( (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged C Ascii)
97 ≡ cs referenceLocalTime
100 , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) ∷ Tagged C Ascii))
103 , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii))
104 ≡ Just referenceZonedTime
107 , property ( (Tagged "Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Tagged RFC733 Ascii)
108 ≡ cs referenceZonedTime
111 , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) ∷ Tagged RFC733 Ascii))
114 , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii))
115 ≡ Just referenceZonedTime
118 , property ( (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii)
119 ≡ cs referenceZonedTime
121 , property $ \zt → Just (untag zt) ≡ fromAttempt (ca (cs (untag (zt ∷ Tagged Cent20 ZonedTime))
122 ∷ Tagged RFC822 Ascii))
125 , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii))
126 ≡ Just referenceZonedTime
129 , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii)
130 ≡ cs referenceZonedTime
133 , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) ∷ Tagged RFC1123 Ascii))
136 , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged HTTP Ascii)
137 ≡ cs referenceUTCTime
139 , property $ \ut → Just ut ≡ fromAttempt (ca (cs ut ∷ Tagged HTTP Ascii) ∷ Attempt UTCTime)
140 , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2lt ut) ∷ Tagged C Ascii)))
141 , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC733 Ascii)))
142 , property $ \ut → Just (untag ut) ≡ fromAttempt (ca (retagHTTP (cs (ut2zt (untag (ut ∷ Tagged Cent20 UTCTime)))
143 ∷ Tagged RFC822 Ascii)))
144 , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii)))
147 referenceLocalTime ∷ LocalTime
149 = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)
151 referenceZonedTime ∷ ZonedTime
153 = ZonedTime referenceLocalTime utc
155 referenceUTCTime ∷ UTCTime
157 = zonedTimeToUTC referenceZonedTime
159 ut2lt ∷ UTCTime → LocalTime
160 ut2lt = utcToLocalTime utc
162 ut2zt ∷ UTCTime → ZonedTime
163 ut2zt = utcToZonedTime utc
165 retagHTTP ∷ Tagged s b → Tagged HTTP b