Tests for Data.Time.RFC733
[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.RFC733  as RFC733
12 import qualified Data.Time.RFC1123 as RFC1123
13 import System.Exit
14 import Prelude.Unicode
15 import Test.QuickCheck
16
17 main ∷ IO ()
18 main = mapM_ runTest tests
19
20 runTest ∷ Property → IO ()
21 runTest prop
22     = do r ← quickCheckResult prop
23          case r of
24            Success {}           → return ()
25            GaveUp  {}           → exitFailure
26            Failure {}           → exitFailure
27            NoExpectedFailure {} → exitFailure
28
29 instance Arbitrary Day where
30     arbitrary = ModifiedJulianDay <$> arbitrary
31
32 instance Arbitrary TimeOfDay where
33     arbitrary
34         = do h ← choose (0, 23)
35              m ← choose (0, 59)
36              s ← choose (0, 60)
37              return $ TimeOfDay h m (fromIntegral (s ∷ Int))
38
39 instance Arbitrary LocalTime where
40     arbitrary = LocalTime <$> arbitrary ⊛ arbitrary
41
42 instance Eq ZonedTime where
43     a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b
44
45 instance Arbitrary TimeZone where
46     arbitrary
47         = do m ← choose (-1439, 1439)
48              s ← arbitrary
49              n ← arbitrary
50              return $ TimeZone m s n
51
52 instance Arbitrary ZonedTime where
53     arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary
54
55 tests ∷ [Property]
56 tests = [ -- Asctime
57           property ( Asctime.fromAscii "Sun Nov  6 08:49:37 1994"
58                      ≡ Right referenceLocalTime )
59
60         , property ( "Sun Nov  6 08:49:37 1994"
61                      ≡ Asctime.toAscii referenceLocalTime )
62
63         , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt)
64
65           -- RFC733
66         , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT"
67                      ≡ Right referenceZonedTime )
68
69         , property ( "Sunday, 06-Nov-1994 08:49:37 GMT"
70                      ≡ RFC733.toAscii referenceZonedTime )
71
72         , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt)
73
74           -- RFC1123
75         , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"
76                      ≡ Right referenceZonedTime )
77
78         , property ( "Sun, 06 Nov 1994 08:49:37 GMT"
79                      ≡ RFC1123.toAscii referenceZonedTime )
80
81         , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt)
82         ]
83     where
84       referenceLocalTime
85           = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)
86
87       referenceZonedTime
88           = ZonedTime referenceLocalTime utc