{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  #-}
module Main (main) where
import Control.Applicative
import Control.Applicative.Unicode
import Data.Ascii (Ascii)
import Data.Convertible.Base
import Data.Tagged
import Data.Time
import Data.Time.Asctime
import qualified Data.Time.HTTP    as HTTP
import qualified Data.Time.RFC733  as RFC733
import qualified Data.Time.RFC1123 as RFC1123
import System.Exit
import Prelude.Unicode
import Test.QuickCheck

main ∷ IO ()
main = mapM_ runTest tests

runTest ∷ Property → IO ()
runTest prop
    = do r ← quickCheckResult prop
         case r of
           Success {}           → return ()
           GaveUp  {}           → exitFailure
           Failure {}           → exitFailure
           NoExpectedFailure {} → exitFailure

instance Arbitrary Day where
    arbitrary = ModifiedJulianDay <$> arbitrary

instance Arbitrary TimeOfDay where
    arbitrary
        = do h ← choose (0, 23)
             m ← choose (0, 59)
             s ← choose (0, 60)
             return $ TimeOfDay h m (fromIntegral (s ∷ Int))

instance Arbitrary LocalTime where
    arbitrary = LocalTime <$> arbitrary ⊛ arbitrary

instance Eq ZonedTime where
    a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b

instance Arbitrary TimeZone where
    arbitrary
        = do m ← choose (-1439, 1439)
             s ← arbitrary
             n ← arbitrary
             return $ TimeZone m s n

instance Arbitrary ZonedTime where
    arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary

instance Arbitrary DiffTime where
    arbitrary = secondsToDiffTime <$> choose (0, 86400)

instance Arbitrary UTCTime where
    arbitrary = UTCTime <$> arbitrary ⊛ arbitrary

tests ∷ [Property]
tests = [ -- Asctime
          property ( convertUnsafe ( Tagged "Sun Nov  6 08:49:37 1994"
                                     ∷ Tagged Asctime Ascii
                                   )
                     ≡ referenceLocalTime
                   )

        , property ( ( Tagged "Sun Nov  6 08:49:37 1994"
                       ∷ Tagged Asctime Ascii
                     )
                     ≡ cs referenceLocalTime
                   )

        , property $ \lt → lt ≡ convertUnsafe ( cs (lt ∷ LocalTime)
                                                ∷ Tagged Asctime Ascii
                                              )

          -- RFC733
        , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT"
                     ≡ Right referenceZonedTime )

        , property ( "Sunday, 06-Nov-1994 08:49:37 GMT"
                     ≡ RFC733.toAscii referenceZonedTime )

        , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt)

          -- RFC1123
        , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"
                     ≡ Right referenceZonedTime )

        , property ( "Sun, 06 Nov 1994 08:49:37 GMT"
                     ≡ RFC1123.toAscii referenceZonedTime )

        , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt)

          -- HTTP
        , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii           ut )
        , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii))
        , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii  (ut2zt ut))
        , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut))
        ]
    where
      referenceLocalTime
          = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)

      referenceZonedTime
          = ZonedTime referenceLocalTime utc

      ut2lt = utcToLocalTime utc

      ut2zt = utcToZonedTime utc