instance Arbitrary (Tagged Cent20 UTCTime) where
arbitrary = (Tagged ∘) ∘ UTCTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary
+instance Arbitrary (Tagged C LocalTime) where
+ arbitrary = Tagged <$> arbitrary
+
+instance Arbitrary (Tagged RFC733 ZonedTime) where
+ arbitrary = Tagged <$> arbitrary
+
+instance Arbitrary (Tagged RFC1123 ZonedTime) where
+ arbitrary = Tagged <$> arbitrary
+
+instance Arbitrary (Tagged HTTP UTCTime) where
+ arbitrary = Tagged <$> arbitrary
+
tests ∷ [Property]
tests = [ -- Asctime
- property ( fromAttempt (ca (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged C Ascii))
- ≡ Just referenceLocalTime
+ property ( fromAttempt (ca ("Sun Nov 6 08:49:37 1994" ∷ Ascii))
+ ≡ Just (Tagged referenceLocalTime ∷ Tagged C LocalTime)
)
- , property ( (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged C Ascii)
- ≡ cs referenceLocalTime
+ , property ( ("Sun Nov 6 08:49:37 1994" ∷ Ascii)
+ ≡ cs (Tagged referenceLocalTime ∷ Tagged C LocalTime)
)
- , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) ∷ Tagged C Ascii))
+ , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ Tagged C LocalTime) ∷ Ascii))
-- RFC733
- , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii))
- ≡ Just referenceZonedTime
+ , property ( fromAttempt (ca ("Sunday, 06-Nov-94 08:49:37 GMT" ∷ Ascii))
+ ≡ Just (Tagged referenceZonedTime ∷ Tagged RFC733 ZonedTime)
)
- , property ( (Tagged "Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Tagged RFC733 Ascii)
- ≡ cs referenceZonedTime
+ , property ( ("Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Ascii)
+ ≡ cs (Tagged referenceZonedTime ∷ Tagged RFC733 ZonedTime)
)
- , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) ∷ Tagged RFC733 Ascii))
+ , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ Tagged RFC733 ZonedTime) ∷ Ascii))
-- RFC822
- , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii))
- ≡ Just referenceZonedTime
+ , property ( fromAttempt (ca ("Sun, 06 Nov 94 08:49:37 GMT" ∷ Ascii))
+ ≡ Just (Tagged referenceZonedTime ∷ Tagged RFC822 ZonedTime)
)
- , property ( Just (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii)
- ≡ fromAttempt (ca referenceZonedTime)
+ , property ( Just ("Sun, 06 Nov 94 08:49:37 GMT" ∷ Ascii)
+ ≡ fromAttempt (ca (Tagged referenceZonedTime ∷ Tagged RFC822 ZonedTime))
)
- , property $ \zt → let zt' = do a ← ca $ untag (zt ∷ Tagged Cent20 ZonedTime)
- ca (a ∷ Tagged RFC822 Ascii)
+
+ , property $ \zt → let zt' = do a ← ca (retag (zt ∷ Tagged Cent20 ZonedTime) ∷ Tagged RFC822 ZonedTime)
+ ca (a ∷ Ascii) ∷ Attempt (Tagged RFC822 ZonedTime)
in
- fromAttempt zt' ≡ Just (untag zt)
+ fromAttempt zt' ≡ Just (retag zt)
-- RFC1123
- , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii))
- ≡ Just referenceZonedTime
+ , property ( fromAttempt (ca ("Sun, 06 Nov 1994 08:49:37 GMT" ∷ Ascii))
+ ≡ Just (Tagged referenceZonedTime ∷ Tagged RFC1123 ZonedTime)
)
- , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii)
- ≡ cs referenceZonedTime
+ , property ( ("Sun, 06 Nov 1994 08:49:37 GMT" ∷ Ascii)
+ ≡ cs (Tagged referenceZonedTime ∷ Tagged RFC1123 ZonedTime)
)
- , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) ∷ Tagged RFC1123 Ascii))
+ , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ Tagged RFC1123 ZonedTime) ∷ Ascii))
-- HTTP
- , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged HTTP Ascii)
- ≡ cs referenceUTCTime
+ , property ( ("Sun, 06 Nov 1994 08:49:37 GMT" ∷ Ascii)
+ ≡ cs (Tagged referenceUTCTime ∷ Tagged HTTP UTCTime)
)
- , property $ \ut → Just ut ≡ fromAttempt (ca (cs ut ∷ Tagged HTTP Ascii) ∷ Attempt UTCTime)
- , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2lt ut) ∷ Tagged C Ascii)))
- , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC733 Ascii)))
+ , property $ \ut → Just ut ≡ fromAttempt (ca (cs (ut ∷ Tagged HTTP UTCTime) ∷ Ascii))
+ , property $ \ut → Just ut ≡ fromAttempt (ca (cs (retag (ut2lt <$> (ut ∷ Tagged HTTP UTCTime))
+ ∷ Tagged C LocalTime)
+ ∷ Ascii))
+ , property $ \ut → Just ut ≡ fromAttempt (ca (cs (retag (ut2zt <$> (ut ∷ Tagged HTTP UTCTime))
+ ∷ Tagged RFC733 ZonedTime)
+ ∷ Ascii))
, property $ \ut → let zt = ut2zt $ untag (ut ∷ Tagged Cent20 UTCTime)
- ut' = do a ← ca zt
- ca $ retagHTTP (a ∷ Tagged RFC822 Ascii)
+ ut' = do a ← ca (Tagged zt ∷ Tagged RFC822 ZonedTime)
+ ca (a ∷ Ascii) ∷ Attempt (Tagged HTTP UTCTime)
in
- fromAttempt ut' ≡ Just (untag ut)
- , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii)))
+ fromAttempt ut' ≡ Just (retag ut)
+ , property $ \ut → Just ut ≡ fromAttempt (ca (cs (retag (ut2zt <$> (ut ∷ Tagged HTTP UTCTime))
+ ∷ Tagged RFC1123 ZonedTime)
+ ∷ Ascii))
]
where
referenceLocalTime ∷ LocalTime
ut2zt ∷ UTCTime → ZonedTime
ut2zt = utcToZonedTime utc
-
- retagHTTP ∷ Tagged s b → Tagged HTTP b
- retagHTTP = retag