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