X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Test%2FTime%2FHTTP.hs;fp=Test%2FTime%2FHTTP.hs;h=0000000000000000000000000000000000000000;hp=25e9e47fb9d087dac57375b0feeeaed285f92295;hb=91c2402d530afff7f1fd4eee333f84cbe18d1014;hpb=7fd4893fdd44f360647fa99c7f96ed96d2f7bac4 diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs deleted file mode 100644 index 25e9e47..0000000 --- a/Test/Time/HTTP.hs +++ /dev/null @@ -1,169 +0,0 @@ -{-# LANGUAGE - FlexibleInstances - , OverloadedStrings - , UnicodeSyntax - #-} -module Main (main) where -import Control.Applicative -import Control.Applicative.Unicode -import Data.Ascii (Ascii) -import Data.Attempt hiding (Failure, Success) -import Data.Convertible.Base -import Data.Proxy -import Data.Tagged -import Data.Time -import Data.Time.Asctime -import Data.Time.HTTP -import Data.Time.RFC733 -import Data.Time.RFC822 -import Data.Time.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 - -data Cent20 - -cent20 ∷ Proxy Cent20 -cent20 = Proxy - -instance Arbitrary Day where - arbitrary = ModifiedJulianDay <$> arbitrary - -instance Arbitrary (Tagged Cent20 Day) where - arbitrary = ((Tagged ∘) ∘) ∘ fromGregorian - <$> choose (1900, 1999) - ⊛ arbitrary - ⊛ 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 Arbitrary (Tagged Cent20 LocalTime) where - arbitrary = (Tagged ∘) ∘ LocalTime <$> - (flip proxy cent20 <$> 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 (Tagged Cent20 ZonedTime) where - arbitrary = (Tagged ∘) ∘ ZonedTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary - -instance Arbitrary DiffTime where - arbitrary = secondsToDiffTime <$> choose (0, 86400) - -instance Arbitrary UTCTime where - arbitrary = UTCTime <$> arbitrary ⊛ arbitrary - -instance Arbitrary (Tagged Cent20 UTCTime) where - arbitrary = (Tagged ∘) ∘ UTCTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary - -tests ∷ [Property] -tests = [ -- Asctime - property ( fromAttempt (ca (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged Asctime Ascii)) - ≡ Just referenceLocalTime - ) - - , property ( (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged Asctime Ascii) - ≡ cs referenceLocalTime - ) - - , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) - ∷ Tagged Asctime Ascii)) - - -- RFC733 - , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii)) - ≡ Just referenceZonedTime - ) - - , property ( (Tagged "Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Tagged RFC733 Ascii) - ≡ cs referenceZonedTime - ) - - , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) - ∷ Tagged RFC733 Ascii)) - - -- RFC822 - , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii)) - ≡ Just referenceZonedTime - ) - - , property ( (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii) - ≡ cs referenceZonedTime - ) - , property $ \zt → Just (untag zt) ≡ fromAttempt (ca (cs (untag (zt ∷ Tagged Cent20 ZonedTime)) - ∷ Tagged RFC822 Ascii)) - - -- RFC1123 - , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii)) - ≡ Just referenceZonedTime - ) - - , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii) - ≡ cs referenceZonedTime - ) - - , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) - ∷ Tagged RFC1123 Ascii)) - - -- HTTP - , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged HTTP Ascii) - ≡ cs referenceUTCTime - ) - , property $ \ut → Just ut ≡ fromAttempt (ca (cs ut ∷ Tagged HTTP Ascii) ∷ Attempt UTCTime) - , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2lt ut) ∷ Tagged Asctime Ascii))) - , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC733 Ascii))) - , property $ \ut → Just (untag ut) ≡ fromAttempt (ca (retagHTTP (cs (ut2zt (untag (ut ∷ Tagged Cent20 UTCTime))) - ∷ Tagged RFC822 Ascii))) - , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii))) - ] - where - referenceLocalTime ∷ LocalTime - referenceLocalTime - = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37) - - referenceZonedTime ∷ ZonedTime - referenceZonedTime - = ZonedTime referenceLocalTime utc - - referenceUTCTime ∷ UTCTime - referenceUTCTime - = zonedTimeToUTC referenceZonedTime - - ut2lt ∷ UTCTime → LocalTime - ut2lt = utcToLocalTime utc - - ut2zt ∷ UTCTime → ZonedTime - ut2zt = utcToZonedTime utc - - retagHTTP ∷ Tagged s b → Tagged HTTP b - retagHTTP = retag