Test/Time/HTTP.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 module Main (main) where
   6 import Control.Applicative
   7 import Control.Applicative.Unicode
   8 import Data.Time
   9 import qualified Data.Time.Asctime as Asctime
  10 import qualified Data.Time.HTTP    as HTTP
  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 instance Arbitrary DiffTime where
  56     arbitrary = secondsToDiffTime <$> choose (0, 86400)
  57
  58 instance Arbitrary UTCTime where
  59     arbitrary = UTCTime <$> arbitrary ⊛ arbitrary
  60
  61 tests ∷ [Property]
  62 tests = [ -- Asctime
  63           property ( Asctime.fromAscii "Sun Nov  6 08:49:37 1994"
  64                      ≡ Right referenceLocalTime )
  65
  66         , property ( "Sun Nov  6 08:49:37 1994"
  67                      ≡ Asctime.toAscii referenceLocalTime )
  68
  69         , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt)
  70
  71           -- RFC733
  72         , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT"
  73                      ≡ Right referenceZonedTime )
  74
  75         , property ( "Sunday, 06-Nov-1994 08:49:37 GMT"
  76                      ≡ RFC733.toAscii referenceZonedTime )
  77
  78         , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt)
  79
  80           -- RFC1123
  81         , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"
  82                      ≡ Right referenceZonedTime )
  83
  84         , property ( "Sun, 06 Nov 1994 08:49:37 GMT"
  85                      ≡ RFC1123.toAscii referenceZonedTime )
  86
  87         , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt)
  88
  89           -- HTTP
  90         , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii           ut )
  91         , property $ \ut → Right ut ≡ HTTP.fromAscii (Asctime.toAscii (ut2lt ut))
  92         , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii  (ut2zt ut))
  93         , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut))
  94         ]
  95     where
  96       referenceLocalTime
  97           = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)
  98
  99       referenceZonedTime
 100           = ZonedTime referenceLocalTime utc
 101
 102       ut2lt = utcToLocalTime utc
 103
 104       ut2zt = utcToZonedTime utc