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 System.Exit
  12 import Prelude.Unicode
  13 import Test.QuickCheck
  14
  15 main ∷ IO ()
  16 main = mapM_ runTest tests
  17
  18 runTest ∷ Property → IO ()
  19 runTest prop
  20     = do r ← quickCheckResult prop
  21          case r of
  22            Success {}           → return ()
  23            GaveUp  {}           → exitFailure
  24            Failure {}           → exitFailure
  25            NoExpectedFailure {} → exitFailure
  26
  27 instance Arbitrary Day where
  28     arbitrary = ModifiedJulianDay <$> arbitrary
  29
  30 instance Arbitrary TimeOfDay where
  31     arbitrary
  32         = do h ← choose (0, 23)
  33              m ← choose (0, 59)
  34              s ← choose (0, 60)
  35              return $ TimeOfDay h m (fromIntegral (s ∷ Int))
  36
  37 instance Arbitrary LocalTime where
  38     arbitrary = LocalTime <$> arbitrary ⊛ arbitrary
  39
  40 tests ∷ [Property]
  41 tests = [ -- Asctime
  42           property ( Asctime.fromAscii "Sun Nov  6 08:49:37 1994"
  43                      ≡ Right (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) )
  44         , property ( Asctime.toAscii (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37))
  45                      ≡ "Sun Nov  6 08:49:37 1994" )
  46         , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt)
  47         ]