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