cereal-time-0.1.0.0: tests/Main.hs

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main where

import Data.Char (isAlpha)
import Data.Function (on)
import Data.Proxy (Proxy(..))
import Data.Serialize (Serialize(..), encode, decode)
import Data.Time.Calendar (Day(..))
import Data.Time.Calendar.Serialize ()
import Data.Time.Clock (UniversalTime(..), DiffTime, UTCTime(..), NominalDiffTime)
import Data.Time.Clock (picosecondsToDiffTime)
import Data.Time.Clock.Serialize()
import Data.Time.Clock.TAI (AbsoluteTime)
import Data.Time.Clock.TAI (addAbsoluteTime, taiEpoch)
import Data.Time.Clock.TAI.Serialize ()
import Data.Time.Format (TimeLocale(..))
import Data.Time.Format.Serialize ()
import Data.Time.LocalTime (TimeZone(..), TimeOfDay(..), LocalTime(..), ZonedTime(..))
import Data.Time.LocalTime.Serialize ()
import Test.Hspec (Spec, shouldBe, describe, hspec)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (Arbitrary(..), suchThat, resize, listOf, choose)

#if MIN_VERSION_base(4,8,0)
import Data.Typeable (Typeable, typeRep)
#endif

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif


main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "Serialization roundtrip" serializationRoundTripSpec

serializationRoundTripSpec :: Spec
serializationRoundTripSpec = do
  propRoundTrip (Proxy :: Proxy Day)
  propRoundTrip (Proxy :: Proxy UniversalTime)
  propRoundTrip (Proxy :: Proxy DiffTime)
  propRoundTrip (Proxy :: Proxy UTCTime)
  propRoundTrip (Proxy :: Proxy AbsoluteTime)
  propRoundTrip (Proxy :: Proxy TimeZone)
  propRoundTrip (Proxy :: Proxy TimeOfDay)
  propRoundTrip (Proxy :: Proxy LocalTime)
  propRoundTrip (Proxy :: Proxy ZonedTime)
  propRoundTrip (Proxy :: Proxy TimeLocale)

#if MIN_VERSION_base(4,8,0)
mkTestName
  :: (Serialize a, Arbitrary a, Show a, Eq a, Typeable a)
  => Proxy a
  -> String
mkTestName a = "(" ++ (show . typeRep $ a) ++ ")"

propRoundTrip
  :: (Serialize a, Arbitrary a, Show a, Eq a, Typeable a)
  => Proxy a
  -> Spec
propRoundTrip a = prop (mkTestName a) $
  \x -> x `shouldBe` (roundTrip a x)
#else
propRoundTrip
  :: (Serialize a, Arbitrary a, Show a, Eq a)
  => Proxy a
  -> Spec
propRoundTrip a = prop "_" $ \x -> x `shouldBe` (roundTrip a x)
#endif

roundTrip :: (Serialize a) => Proxy a -> a -> a
roundTrip _ = either error id . decode . encode


instance Arbitrary Day where
  arbitrary = ModifiedJulianDay <$> arbitrary

instance Arbitrary UniversalTime where
  arbitrary = ModJulianDate <$> arbitrary

instance Arbitrary DiffTime where
  arbitrary = picosecondsToDiffTime <$> arbitrary

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

instance Arbitrary NominalDiffTime where
  arbitrary = fromRational <$> arbitrary

instance Arbitrary AbsoluteTime where
  arbitrary = (flip addAbsoluteTime taiEpoch) <$> arbitrary

instance Arbitrary TimeZone where
  arbitrary = TimeZone
    <$> arbitrary
    <*> arbitrary
    <*> (resize 4 $ listOf (arbitrary `suchThat` isAlpha))

instance Arbitrary TimeOfDay where
  arbitrary = TimeOfDay
    <$> (choose (0, 23))
    <*> (choose (0, 59))
    <*> ((fromRational <$> arbitrary) `suchThat` (\s -> (s >= (fromInteger 0)) && (s < (fromInteger 61))))

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

-- Per-component equality test (we do not expect serialization to change time zone).
instance Eq ZonedTime where
  (==) = curry $ flip all components . flip ($) where
    test f = uncurry ((==) `on` f)
    components = [
        test zonedTimeToLocalTime
      , test zonedTimeZone
      ]

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

instance Arbitrary TimeLocale where
  arbitrary = TimeLocale
    <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary