Tests for Data.Time.HTTP
[time-http.git] / Test / Time / HTTP.hs
1 {-# LANGUAGE
2     OverloadedStrings
3   , UnicodeSyntax
4   , ViewPatterns
5   #-}
6 module Main (main) where
7 import Control.Applicative
8 import Control.Applicative.Unicode
9 import Data.Time
10 import qualified Data.Time.Asctime as Asctime
11 import qualified Data.Time.HTTP    as HTTP
12 import qualified Data.Time.RFC733  as RFC733
13 import qualified Data.Time.RFC1123 as RFC1123
14 import System.Exit
15 import Prelude.Unicode
16 import Test.QuickCheck
17
18 main ∷ IO ()
19 main = mapM_ runTest tests
20
21 runTest ∷ Property → IO ()
22 runTest prop
23     = do r ← quickCheckResult prop
24          case r of
25            Success {}           → return ()
26            GaveUp  {}           → exitFailure
27            Failure {}           → exitFailure
28            NoExpectedFailure {} → exitFailure
29
30 instance Arbitrary Day where
31     arbitrary = ModifiedJulianDay <$> arbitrary
32
33 instance Arbitrary TimeOfDay where
34     arbitrary
35         = do h ← choose (0, 23)
36              m ← choose (0, 59)
37              s ← choose (0, 60)
38              return $ TimeOfDay h m (fromIntegral (s ∷ Int))
39
40 instance Arbitrary LocalTime where
41     arbitrary = LocalTime <$> arbitrary ⊛ arbitrary
42
43 instance Eq ZonedTime where
44     a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b
45
46 instance Arbitrary TimeZone where
47     arbitrary
48         = do m ← choose (-1439, 1439)
49              s ← arbitrary
50              n ← arbitrary
51              return $ TimeZone m s n
52
53 instance Arbitrary ZonedTime where
54     arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary
55
56 instance Arbitrary DiffTime where
57     arbitrary = secondsToDiffTime <$> choose (0, 86400)
58
59 instance Arbitrary UTCTime where
60     arbitrary = UTCTime <$> arbitrary ⊛ arbitrary
61
62 tests ∷ [Property]
63 tests = [ -- Asctime
64           property ( Asctime.fromAscii "Sun Nov  6 08:49:37 1994"
65                      ≡ Right referenceLocalTime )
66
67         , property ( "Sun Nov  6 08:49:37 1994"
68                      ≡ Asctime.toAscii referenceLocalTime )
69
70         , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt)
71
72           -- RFC733
73         , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT"
74                      ≡ Right referenceZonedTime )
75
76         , property ( "Sunday, 06-Nov-1994 08:49:37 GMT"
77                      ≡ RFC733.toAscii referenceZonedTime )
78
79         , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt)
80
81           -- RFC1123
82         , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"
83                      ≡ Right referenceZonedTime )
84
85         , property ( "Sun, 06 Nov 1994 08:49:37 GMT"
86                      ≡ RFC1123.toAscii referenceZonedTime )
87
88         , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt)
89
90           -- HTTP
91         , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii           ut )
92         , property $ \ut → Right ut ≡ HTTP.fromAscii (Asctime.toAscii (ut2lt ut))
93         , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii  (ut2zt ut))
94         , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut))
95         ]
96     where
97       referenceLocalTime
98           = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)
99
100       referenceZonedTime
101           = ZonedTime referenceLocalTime utc
102
103       ut2lt = utcToLocalTime utc
104
105       ut2zt = utcToZonedTime utc