-- | -- Module : Data.Hourglass.Time -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- generic time representation interface to allow -- arbitrary conversion between different time representation -- {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.Hourglass.Time ( -- * Generic time classes Time(..) , Timeable(..) -- * Elapsed time , Elapsed(..) , ElapsedP(..) -- * Generic conversion , timeConvert -- * Date and Time , timeGetDate , timeGetDateTimeOfDay , timeGetTimeOfDay -- * Arithmetic , 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(..)) -- | Timeable represent every type that can be made to look like time types. -- -- * can be converted to ElapsedP and Elapsed -- -- * optionally have a timezone associated -- -- * have nanoseconds accessor (which can return 0 when the type is not more precise than seconds) -- class Timeable t where -- | convert a time representation to the number of elapsed seconds and nanoseconds to a specific epoch timeGetElapsedP :: t -> ElapsedP -- | convert a time representation to the number of elapsed seconds to a specific epoch. -- -- defaults to timeGetElapsedP unless defined explicitely by an instance timeGetElapsed :: t -> Elapsed timeGetElapsed t = e where ElapsedP e _ = timeGetElapsedP t -- | return the number of optional nanoseconds. -- -- If the underlaying type is not precise enough to record nanoseconds -- (or any variant between seconds and nanoseconds), 0 should be returned -- -- defaults to 'timeGetElapsedP' unless defined explicitely by an instance, -- for efficiency reason, it's a good idea to override this methods if -- you know the type is not more precise than Seconds. timeGetNanoSeconds :: t -> NanoSeconds timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t -- | Represent time types that can be created from other time types. -- -- Every conversion happens throught ElapsedP or Elapsed types. class Timeable t => Time t where -- | convert from a number of elapsed seconds and nanoseconds to another time representation timeFromElapsedP :: ElapsedP -> t -- | convert from a number of elapsed seconds and nanoseconds to another time representation -- -- defaults to timeFromElapsedP unless defined explicitely by an instance. 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 -- | Convert one time representation into another one -- -- The return type need to be infer by the context. -- -- If the context cannot be infer through this, some specialized functions -- are available for built-in types: -- -- * 'timeGetDate' -- -- * 'timeGetDateTimeOfDay' -- -- * 'timeGetElapsed', 'timeGetElapsedP' 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 #-} -- | Get the calendar Date (year-month-day) from a time representation -- -- specialization of 'timeConvert' 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 #-} -- | Get the day time (hours:minutes:seconds) from a time representation -- -- specialization of 'timeConvert' 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 #-} -- | Get the date and time of day from a time representation -- -- specialization of 'timeConvert' 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) #-} -- | add some time interval to a time representation and returns this new time representation -- -- example: -- -- > t1 `timeAdd` mempty { durationHours = 12 } timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t timeAdd t ti = timeFromElapsedP $ elapsedTimeAddSecondsP (timeGetElapsedP t) (toSeconds ti) -- | Get the difference in seconds between two time representation -- -- effectively: -- -- > t2 `timeDiff` t1 = t2 - t1 timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds timeDiff t1 t2 = sec where (Elapsed sec) = timeGetElapsed t1 - timeGetElapsed t2 -- | Get the difference in seconds and nanoseconds between two time representation -- -- effectively: -- -- > @t2 `timeDiffP` t1 = t2 - t1 timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds) timeDiffP t1 t2 = (sec, ns) where (ElapsedP (Elapsed sec) ns) = timeGetElapsedP t1 - timeGetElapsedP t2