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