{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Hourglass.Time
(
Time(..)
, Timeable(..)
, Elapsed(..)
, ElapsedP(..)
, timeConvert
, timeGetDate
, timeGetDateTimeOfDay
, timeGetTimeOfDay
, Duration(..)
, Period(..)
, TimeInterval(..)
, timeAdd
, timeDiff
, timeDiffP
, dateAddPeriod
) where
import Data.Data ()
import Data.Hourglass.Types
import Data.Hourglass.Calendar
import Data.Hourglass.Diff
import Foreign.C.Types (CTime(..))
class Timeable t where
timeGetElapsedP :: t -> ElapsedP
timeGetElapsed :: t -> Elapsed
timeGetElapsed t = e where ElapsedP e _ = timeGetElapsedP t
timeGetNanoSeconds :: t -> NanoSeconds
timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t
class Timeable t => Time t where
timeFromElapsedP :: ElapsedP -> t
timeFromElapsed :: Elapsed -> t
timeFromElapsed e = timeFromElapsedP (ElapsedP e 0)
#if (MIN_VERSION_base(4,5,0))
instance Timeable CTime where
timeGetElapsedP c = ElapsedP (timeGetElapsed c) 0
timeGetElapsed (CTime c) = Elapsed (Seconds $ fromIntegral c)
timeGetNanoSeconds _ = 0
instance Time CTime where
timeFromElapsedP (ElapsedP e _) = timeFromElapsed e
timeFromElapsed (Elapsed (Seconds c)) = CTime (fromIntegral c)
#endif
instance Timeable Elapsed where
timeGetElapsedP e = ElapsedP e 0
timeGetElapsed e = e
timeGetNanoSeconds _ = 0
instance Time Elapsed where
timeFromElapsedP (ElapsedP e _) = e
timeFromElapsed e = e
instance Timeable ElapsedP where
timeGetElapsedP e = e
timeGetNanoSeconds (ElapsedP _ ns) = ns
instance Time ElapsedP where
timeFromElapsedP e = e
instance Timeable Date where
timeGetElapsedP d = timeGetElapsedP (DateTime d (TimeOfDay 0 0 0 0))
instance Time Date where
timeFromElapsedP (ElapsedP elapsed _) = d
where (DateTime d _) = dateTimeFromUnixEpoch elapsed
instance Timeable DateTime where
timeGetElapsedP d = ElapsedP (dateTimeToUnixEpoch d) (timeGetNanoSeconds d)
timeGetElapsed d = dateTimeToUnixEpoch d
timeGetNanoSeconds (DateTime _ (TimeOfDay _ _ _ ns)) = ns
instance Time DateTime where
timeFromElapsedP elapsed = dateTimeFromUnixEpochP elapsed
timeConvert :: (Timeable t1, Time t2) => t1 -> t2
timeConvert t1 = timeFromElapsedP (timeGetElapsedP t1)
{-# INLINE[2] timeConvert #-}
{-# RULES "timeConvert/ID" timeConvert = id #-}
{-# RULES "timeConvert/ElapsedP" timeConvert = timeGetElapsedP #-}
{-# RULES "timeConvert/Elapsed" timeConvert = timeGetElapsed #-}
timeGetDate :: Timeable t => t -> Date
timeGetDate t = d where (DateTime d _) = timeGetDateTimeOfDay t
{-# INLINE[2] timeGetDate #-}
{-# RULES "timeGetDate/ID" timeGetDate = id #-}
{-# RULES "timeGetDate/DateTime" timeGetDate = dtDate #-}
timeGetTimeOfDay :: Timeable t => t -> TimeOfDay
timeGetTimeOfDay t = tod where (DateTime _ tod) = timeGetDateTimeOfDay t
{-# INLINE[2] timeGetTimeOfDay #-}
{-# RULES "timeGetTimeOfDay/Date" timeGetTimeOfDay = const (TimeOfDay 0 0 0 0) #-}
{-# RULES "timeGetTimeOfDay/DateTime" timeGetTimeOfDay = dtTime #-}
timeGetDateTimeOfDay :: Timeable t => t -> DateTime
timeGetDateTimeOfDay t = dateTimeFromUnixEpochP $ timeGetElapsedP t
{-# INLINE[2] timeGetDateTimeOfDay #-}
{-# RULES "timeGetDateTimeOfDay/ID" timeGetDateTimeOfDay = id #-}
{-# RULES "timeGetDateTimeOfDay/Date" timeGetDateTimeOfDay = flip DateTime (TimeOfDay 0 0 0 0) #-}
timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t
timeAdd t ti = timeFromElapsedP $ elapsedTimeAddSecondsP (timeGetElapsedP t) (toSeconds ti)
timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds
timeDiff t1 t2 = sec where (Elapsed sec) = timeGetElapsed t1 - timeGetElapsed t2
timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds)
timeDiffP t1 t2 = (sec, ns)
where (ElapsedP (Elapsed sec) ns) = timeGetElapsedP t1 - timeGetElapsedP t2