module Data.DateTime where
import Data.Fixed (div')
import Data.Function (on)
import Data.Maybe (fromJust)
import Data.Time.Calendar hiding (fromGregorian, toGregorian)
import Data.Time.Clock hiding (getCurrentTime)
import Data.Time.Format
import Data.Time.LocalTime
import Numeric (fromRat)
#if !MIN_VERSION_time(1,5,0)
import System.Locale
#endif
import System.Time hiding (toClockTime)
import Test.QuickCheck
import qualified Data.Time.Calendar as Calendar
import qualified Data.Time.Clock as Clock
type DateTime = UTCTime
instance Arbitrary UTCTime where
arbitrary = do
offset <- choose (0, 20000) :: Gen Float
return . fromMJD' $ offset + fromRational startOfTimeMJD
getCurrentTime :: IO DateTime
getCurrentTime = Clock.getCurrentTime
toMJD :: DateTime -> Rational
toMJD = getModJulianDate . toUniversalTime
toMJD' :: RealFloat a => DateTime -> a
toMJD' = fromRat . toMJD
fromMJD :: Rational -> DateTime
fromMJD = fromUniversalTime . ModJulianDate
fromMJD' :: RealFloat a => a -> DateTime
fromMJD' = fromMJD . realToFrac
invariant f x = f x == x
prop_MJD = invariant $ fromMJD . toMJD
prop_MJD' = invariant $ fromMJD' . toMJD'
toUniversalTime :: DateTime -> UniversalTime
toUniversalTime = localTimeToUT1 0 . utcToLocalTime utc
fromUniversalTime :: UniversalTime -> DateTime
fromUniversalTime = localTimeToUTC utc . ut1ToLocalTime 0
prop_Universal = invariant $ fromUniversalTime . toUniversalTime
toGregorian' :: DateTime -> (Integer, Int, Int)
toGregorian' dt = (y, m, d)
where
(y, m, d, _, _, _) = toGregorian dt
toGregorian :: DateTime -> (Integer, Int, Int, Int, Int, Int)
toGregorian dt = (year, month, day', hours, minutes, seconds `div'` 1)
where
LocalTime day tod = utcToLocalTime utc dt
(year, month, day') = Calendar.toGregorian day
TimeOfDay hours minutes seconds = tod
fromGregorian' :: Integer -> Int -> Int -> DateTime
fromGregorian' y m d = fromGregorian y m d 0 0 0
fromGregorian :: Integer -> Int -> Int -> Int -> Int -> Int -> DateTime
fromGregorian year month day hours minutes seconds =
UTCTime day' (secondsToDiffTime . fromIntegral $ seconds')
where
day' = Calendar.fromGregorian year month day
seconds' = 3600 * hours + 60 * minutes + seconds
toSeconds :: DateTime -> Integer
toSeconds dt = floor $
86400.0 * fromRational (toMJD dt startOfTimeMJD)
fromSeconds :: Integer -> DateTime
fromSeconds s = fromMJD $
fromIntegral s / 86400 + startOfTimeMJD
toClockTime :: DateTime -> ClockTime
toClockTime dt = TOD (toSeconds dt) 0
fromClockTime :: ClockTime -> DateTime
fromClockTime (TOD s _) = fromSeconds s
startOfTime :: DateTime
startOfTime = fromGregorian' 1970 1 1
prop_StartOfTime _ = toSeconds startOfTime == 0
startOfTimeMJD :: Rational
startOfTimeMJD = toMJD startOfTime
toSqlString :: DateTime -> String
toSqlString = formatDateTime sqlFormat
fromSqlString :: String -> Maybe DateTime
fromSqlString = parseDateTime sqlFormat
prop_SqlString dt = (fromJust . fromSqlString . toSqlString $ dt') == dt'
where
Just dt' = fromSqlString . toSqlString $ dt
prop_SqlStartOfTime _ = toSqlString startOfTime == "1970-01-01 00:00:00"
formatDateTime :: String -> DateTime -> String
formatDateTime = formatTime defaultTimeLocale
parseDateTime :: String -> String -> Maybe DateTime
parseDateTime = parseTime defaultTimeLocale
sqlFormat = iso8601DateFormat (Just "%T")
addMinutes' :: Int -> DateTime -> DateTime
addMinutes' = addMinutes . fromIntegral
addMinutes :: Integer -> DateTime -> DateTime
addMinutes m = addSeconds (60 * m)
diffMinutes' :: DateTime -> DateTime -> Int
diffMinutes' x = fromIntegral . diffMinutes x
diffMinutes :: DateTime -> DateTime -> Integer
diffMinutes x = (`div` 60) . diffSeconds x
addSeconds :: Integer -> DateTime -> DateTime
addSeconds s dt = fromSeconds $ toSeconds dt + s
diffSeconds :: DateTime -> DateTime -> Integer
diffSeconds = () `on` toSeconds