DateTimeTest.hs

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

module Data.DateTimeTest where

import Test.Framework
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck
import Data.Maybe (fromJust)

import Data.Time.Clock (UTCTime)
import Data.DateTime

instance Arbitrary UTCTime where
    arbitrary       = do
        offset <- choose (0, 20000) :: Gen Float
        return . fromMJD' $ offset + fromRational startOfTimeMJD


tests :: [Test]
tests = [ testGroup "properties"
          [ testProperty "MJD" prop_MJD
          , testProperty "Universal" prop_Universal
          , testProperty "StartOfTime" prop_StartOfTime
          , testProperty "SqlString" prop_SqlString
          -- , testProperty "SqlStartOfTime" prop_SqlStartOfTime
          ]
        ]

invariant :: Eq a => (a -> a) -> a -> Bool
invariant f x = f x == x

prop_MJD :: DateTime -> Bool
prop_MJD  = invariant $ fromMJD  . toMJD

prop_MJD' :: DateTime -> Bool
prop_MJD' = invariant $ fromMJD' . toMJD'

prop_Universal :: DateTime -> Bool
prop_Universal = invariant $ fromUniversalTime . toUniversalTime

prop_StartOfTime :: DateTime -> Bool
prop_StartOfTime _ = toSeconds startOfTime == 0

prop_SqlString :: DateTime -> Bool
prop_SqlString dt = (fromJust . fromSqlString . toSqlString $ dt') == dt'
  where
    Just dt' = fromSqlString . toSqlString $ dt

-- It doesn't seem like this test ever passed, so disabling.
-- prop_SqlStartOfTime :: DateTime -> Bool
-- prop_SqlStartOfTime _ = toSqlString startOfTime == "1970-01-01 00:00:00"