diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,28 @@ +## Version WIP + +- use tasty to replace test-framework +- add some inlining pragma to tentatively deal with rules properly. +- Remove the Time method to get timezone offset, all local time must be handled + through LocalTime +- Remove the Time instance for Localtime. +- add localTimeParse since timeParse is not suitable anymore for LocalTime (no + more time instance). +- add Hours and Minutes types. +- add a time interval class to convert between time unit types. +- add some new derived classes (Enum,Real,Integral) for time unit types. +- split TimeDiff into a Period and Duration structure. + +## Version 0.1.2 (5 May 2014) + +- fix compilation on OSX +- add some system benchmarks +- comment and markup reformating + +## Version 0.1.1 (4 May 2014) + +- add all the cabal tests file to the source dist +- https-ize some urls + +## Version 0.1.0 (4 May 2014) + +- Initial version diff --git a/Data/Hourglass/Calendar.hs b/Data/Hourglass/Calendar.hs --- a/Data/Hourglass/Calendar.hs +++ b/Data/Hourglass/Calendar.hs @@ -11,6 +11,7 @@ ( isLeapYear , getWeekDay , getDayOfTheYear + , daysInMonth , dateToUnixEpoch , dateFromUnixEpoch , todToSeconds @@ -44,14 +45,12 @@ where normalYears = [ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ] leapYears = [ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 ] -{- -- | Return the number of days in a month. daysInMonth :: Int -> Month -> Int daysInMonth y m | m == February && isLeapYear y = 29 | otherwise = days !! fromEnum m where days = [31,28,31,30,31,30,31,31,30,31,30,31] --} -- | return the day of the year where Jan 1 is 0 -- @@ -72,7 +71,7 @@ dateToUnixEpoch :: Date -> Elapsed dateToUnixEpoch date = Elapsed $ Seconds (fromIntegral (daysOfDate date - epochDays) * secondsPerDay) where epochDays = 719163 - secondsPerDay = 86400 + secondsPerDay = 86400 -- julian day is 24h -- | Return the Date associated with the unix epoch dateFromUnixEpoch :: Elapsed -> Date @@ -80,8 +79,7 @@ -- | Return the number of seconds from a time structure todToSeconds :: TimeOfDay -> Seconds -todToSeconds (TimeOfDay h m s _) = - fromIntegral h * 3600 + fromIntegral m * 60 + fromIntegral s +todToSeconds (TimeOfDay h m s _) = toSeconds h + toSeconds m + s -- | Return the number of seconds to unix epoch of a date time dateTimeToUnixEpoch :: DateTime -> Elapsed diff --git a/Data/Hourglass/Diff.hs b/Data/Hourglass/Diff.hs --- a/Data/Hourglass/Diff.hs +++ b/Data/Hourglass/Diff.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Hourglass.Diff -- License : BSD-style @@ -8,88 +9,89 @@ -- time arithmetic methods -- module Data.Hourglass.Diff - ( TimeDiff(..) - , normalizeTimeDiff - , dateTimeAdd + ( Duration(..) + , Period(..) + , durationNormalize + , durationFlatten , elapsedTimeAddSeconds , elapsedTimeAddSecondsP - , elapsedTimeAdd - , elapsedTimeAddP + , dateAddPeriod ) where -import Data.Int +import Data.Data import Data.Monoid import Data.Hourglass.Types import Data.Hourglass.Calendar +import Control.DeepSeq --- | A simple Time difference structure. --- --- A null time difference can be created with 'mempty' and --- the structures can be combined with 'mappend' or 'mconcat'. --- --- Example: +-- | An amount of conceptual calendar time in terms of years, months and days. -- --- > mempty { timeDiffMonths = 1 } `mappend` mempty { timeDiffSeconds = 24 } +-- This allow calendar manipulation, representing things like days and months +-- irrespective on how long those are related to timezone and daylight changes. -- -data TimeDiff = TimeDiff - { timeDiffYears :: Int -- ^ number of years - , timeDiffMonths :: Int -- ^ number of months - , timeDiffDays :: Int -- ^ number of days - , timeDiffHours :: Int -- ^ number of hours - , timeDiffMinutes :: Int -- ^ number of minutes - , timeDiffSeconds :: Int -- ^ number of seconds - , timeDiffNs :: Int -- ^ number of nanoseconds - } deriving (Show,Eq) - --- | simplify a time difference -toSimplerTimeDiff :: TimeDiff -> (Int, Int, Seconds, NanoSeconds) -toSimplerTimeDiff (TimeDiff y m d h mi s ns) = - (y, m, Seconds accSecs, NanoSeconds ns') - where accSecs = (((i64 d * 24) + i64 h) * 60 + i64 mi) * 60 + i64 s + i64 sacc - (sacc, ns') = ns `divMod` 1000000000 +-- See 'Duration' for the time-based equivalent to this class. +data Period = Period + { periodYears :: !Int + , periodMonths :: !Int + , periodDays :: !Int + } deriving (Read,Eq,Ord,Data,Typeable) - i64 :: Int -> Int64 - i64 = fromIntegral +instance NFData Period where + rnf (Period y m d) = y `seq` m `seq` d `seq` () +instance Monoid Period where + mempty = Period 0 0 0 + mappend (Period y1 m1 d1) (Period y2 m2 d2) = + Period (y1+y2) (m1+m2) (d1+d2) -instance Monoid TimeDiff where - mempty = TimeDiff 0 0 0 0 0 0 0 - mappend (TimeDiff f1 f2 f3 f4 f5 f6 f7) (TimeDiff g1 g2 g3 g4 g5 g6 g7) = - TimeDiff (f1+g1) (f2+g2) (f3+g3) (f4+g4) (f5+g5) (f6+g6) (f7+g7) +-- | An amount of time in terms of constant value like hours (3600 seconds), +-- minutes (60 seconds), seconds and nanoseconds. +data Duration = Duration + { durationHours :: !Hours -- ^ number of hours + , durationMinutes :: !Minutes -- ^ number of minutes + , durationSeconds :: !Seconds -- ^ number of seconds + , durationNs :: !NanoSeconds -- ^ number of nanoseconds + } deriving (Read,Eq,Ord,Data,Typeable) --- | Normalize all constant bounded fields, --- i.e. all except days since we don't know to which --- months they apply. -normalizeTimeDiff :: TimeDiff -> TimeDiff -normalizeTimeDiff (TimeDiff y m d h mi s ns) = - TimeDiff y' m' (d+dacc) h' mi' s' ns' - where - y' = y + macc - (macc, m') = m `divMod` 12 - (dacc, h') = (h+hacc) `divMod` 24 - (hacc, mi') = (mi+miacc) `divMod` 60 - (miacc, s') = (s+sacc) `divMod` 60 - (sacc, ns') = ns `divMod` 1000000000 +instance NFData Duration where + rnf (Duration h m s ns) = h `seq` m `seq` s `seq` ns `seq` () +instance Monoid Duration where + mempty = Duration 0 0 0 0 + mappend (Duration h1 m1 s1 ns1) (Duration h2 m2 s2 ns2) = + Duration (h1+h2) (m1+m2) (s1+s2) (ns1+ns2) +instance TimeInterval Duration where + fromSeconds s = (durationNormalize (Duration 0 0 s 0), 0) + toSeconds d = fst $ durationFlatten d --- | relatively add some years and months to a date -dateTimeAddYM :: DateTime -> (Int, Int) -> DateTime -dateTimeAddYM (DateTime (Date y m d) tod) (yDiff, mDiff) = - DateTime (Date (y+yDiff+yDiffAcc) (toEnum mNew) d) tod - where - (yDiffAcc,mNew) = (fromEnum m + mDiff) `divMod` 12 +durationFlatten :: Duration -> (Seconds, NanoSeconds) +durationFlatten (Duration h m s (NanoSeconds ns)) = + (toSeconds h + toSeconds m + s + Seconds sacc, NanoSeconds ns') + where (sacc, ns') = ns `divMod` 1000000000 --- | add to a DateTime -dateTimeAdd :: DateTime -> TimeDiff -> DateTime -dateTimeAdd dt td = - dateTimeFromUnixEpoch $ elapsedTimeAdd (dateTimeToUnixEpoch dt) td +-- | Normalize all fields to represent the same value +-- with the biggest units possible. +-- +-- For example, 62 minutes is normalized as 1h 2minutes +durationNormalize :: Duration -> Duration +durationNormalize (Duration (Hours h) (Minutes mi) (Seconds s) (NanoSeconds ns)) = + Duration (Hours (h+hacc)) (Minutes mi') (Seconds s') (NanoSeconds ns') + where (hacc, mi') = (mi+miacc) `divMod` 60 + (miacc, s') = (s+sacc) `divMod` 60 + (sacc, ns') = ns `divMod` 1000000000 --- | add a (year,month,seconds) to an Elapsed -elapsedTimeAddSimple :: Elapsed -> (Int, Int, Seconds) -> Elapsed -elapsedTimeAddSimple e (y,m,secs) - | y == 0 && m == 0 = e' - | otherwise = - let dt = dateTimeFromUnixEpoch e' - in dateTimeToUnixEpoch $ dateTimeAddYM dt (y, m) - where e' = e + Elapsed secs +-- | add a period of time to a date +dateAddPeriod :: Date -> Period -> Date +dateAddPeriod (Date yOrig mOrig dOrig) (Period yDiff mDiff dDiff) = + loop (yOrig + yDiff + yDiffAcc) mStartPos (dOrig+dDiff) + where + (yDiffAcc,mStartPos) = (fromEnum mOrig + mDiff) `divMod` 12 + loop y m d + | d < dMonth = Date y (toEnum m) d + | otherwise = + let newDiff = d - dMonth + in if m == 12 + then loop (y+1) 0 newDiff + else loop y (m+1) newDiff + where dMonth = daysInMonth y (toEnum m) -- | Add a number of seconds to an Elapsed type elapsedTimeAddSeconds :: Elapsed -> Seconds -> Elapsed @@ -97,19 +99,8 @@ -- | Add a number of seconds to an ElapsedP type elapsedTimeAddSecondsP :: ElapsedP -> Seconds -> ElapsedP -elapsedTimeAddSecondsP (ElapsedP (Elapsed s1) ns1) s2 = ElapsedP (Elapsed (s1+s2)) ns1 - --- | add a time difference -elapsedTimeAdd :: Elapsed -> TimeDiff -> Elapsed -elapsedTimeAdd e td = elapsedTimeAddSimple e (y,m,secs) - where (y,m,secs,_) = toSimplerTimeDiff td - --- | add a time difference with nanoseconds precisions -elapsedTimeAddP :: ElapsedP -> TimeDiff -> ElapsedP -elapsedTimeAddP (ElapsedP e (NanoSeconds ns)) td = ElapsedP e' ns' - where (y,m,secs,ns') = toSimplerTimeDiff td' - e' = elapsedTimeAddSimple e (y,m,secs) - td' = td { timeDiffNs = timeDiffNs td + ns } +elapsedTimeAddSecondsP (ElapsedP (Elapsed s1) ns1) s2 = + ElapsedP (Elapsed (s1+s2)) ns1 {- disabled for warning purpose. to be implemented @@ -137,6 +128,8 @@ -- timeDiffFromDuration :: String -> TimeDiff timeDiffFromDuration _ = undefined + +timeDiffFromString :: String -> ( -- | Human description string to time diff -- diff --git a/Data/Hourglass/Format.hs b/Data/Hourglass/Format.hs --- a/Data/Hourglass/Format.hs +++ b/Data/Hourglass/Format.hs @@ -25,6 +25,9 @@ , timePrint , timeParse , timeParseE + , localTimePrint + , localTimeParse + , localTimeParseE ) where import Data.Hourglass.Types @@ -140,14 +143,12 @@ where dash = Format_Text '-' colon = Format_Text ':' --- | Pretty print time to a string. --- --- The actual output is determined by the format used. -timePrint :: (TimeFormat format, Timeable t) - => format -- ^ the format to use for printing - -> t -- ^ the time to print - -> String -- ^ the resulting string -timePrint fmt t = concatMap fmtToString fmtElems +printWith :: (TimeFormat format, Timeable t) + => format + -> TimezoneOffset + -> t + -> String +printWith fmt tzOfs@(TimezoneOffset tz) t = concatMap fmtToString fmtElems where fmtToString Format_Year = show (dateYear date) fmtToString Format_Year4 = pad4 (dateYear date) fmtToString Format_Year2 = pad2 (dateYear date-1900) @@ -175,23 +176,39 @@ (Elapsed (Seconds unixSecs)) = timeGetElapsed t (DateTime date tm) = timeGetDateTimeOfDay t - tzOfs@(TimezoneOffset tz) = maybe (TimezoneOffset 0) id $ timeGetTimezone t - -- format a number to 4 stricly - --pad4t v = pad4 (v `mod` 10000) +-- | Pretty print local time to a string. +-- +-- The actual output is determined by the format used. +localTimePrint :: (TimeFormat format, Timeable t) + => format -- ^ the format to use for printing + -> LocalTime t -- ^ the local time to print + -> LocalTime String -- ^ the resulting local time string +localTimePrint fmt lt = fmap (printWith fmt (localTimeGetTimezone lt)) lt +-- | Pretty print time to a string +-- +-- The actual output is determined by the format used +timePrint :: (TimeFormat format, Timeable t) + => format -- ^ the format to use for printing + -> t -- ^ the global time to print + -> String -- ^ the resulting string +timePrint fmt t = printWith fmt timezone_UTC t + -- | Try parsing a string as time using the format explicitely specified -- -- On failure, the parsing function returns the reason of the failure. -- If parsing is successful, return the date parsed with the remaining unparsed string -timeParseE :: TimeFormat format - => format -- ^ the format to use for parsing - -> String -- ^ the string to parse - -> Either (TimeFormatElem, String) (LocalTime DateTime, String) -timeParseE fmt timeString = loop ini fmtElems timeString +localTimeParseE :: TimeFormat format + => format -- ^ the format to use for parsing + -> String -- ^ the string to parse + -> Either (TimeFormatElem, String) (LocalTime DateTime, String) +localTimeParseE fmt timeString = loop ini fmtElems timeString where (TimeFormatString fmtElems) = toFormat fmt - loop acc [] s = Right (acc, s) + toLocal (dt, tz) = localTime tz dt + + loop acc [] s = Right (toLocal acc, s) loop _ (x:_) [] = Left (x, "empty") loop acc (x:xs) s = case processOne acc x s of @@ -272,12 +289,12 @@ allDigits = and . map isDigit - ini = LocalTime (DateTime (Date 0 (toEnum 0) 0) (TimeOfDay 0 0 0 0)) (TimezoneOffset 0) + ini = (DateTime (Date 0 (toEnum 0) 0) (TimeOfDay 0 0 0 0), TimezoneOffset 0) - modDT f (LocalTime dt tz) = LocalTime (f dt) tz - modDate f (LocalTime (DateTime d tp) tz) = LocalTime (DateTime (f d) tp) tz - modTime f (LocalTime (DateTime d tp) tz) = LocalTime (DateTime d (f tp)) tz - modTZ f (LocalTime dtp tz) = LocalTime dtp (f tz) + modDT f (dt, tz) = (f dt, tz) + modDate f (DateTime d tp, tz) = (DateTime (f d) tp, tz) + modTime f (DateTime d tp, tz) = (DateTime d (f tp), tz) + modTZ f (dt, tz) = (dt, f tz) setYear y (Date _ m d) = Date y m d setMonth m (Date y _ d) = Date y m d @@ -288,10 +305,21 @@ -- | Try parsing a string as time using the format explicitely specified -- --- The error handling is simplified in this case, for more elaborate need --- use 'timeParseE'. -timeParse :: TimeFormat format - => format -- ^ the format to use for parsing - -> String -- ^ the string to parse - -> Maybe (LocalTime DateTime) -timeParse fmt s = either (const Nothing) (Just . fst) $ timeParseE fmt s +-- Unparsed characters are ignored and the error handling is simplified +-- +-- for more elaborate need use 'localTimeParseE'. +localTimeParse :: TimeFormat format + => format -- ^ the format to use for parsing + -> String -- ^ the string to parse + -> Maybe (LocalTime DateTime) +localTimeParse fmt s = either (const Nothing) (Just . fst) $ localTimeParseE fmt s + +-- | like 'localTimeParseE' but the time value is automatically converted to global time. +timeParseE :: TimeFormat format => format -> String + -> Either (TimeFormatElem, String) (DateTime, String) +timeParseE fmt timeString = either Left (\(d,s) -> Right (localTimeToGlobal d, s)) + $ localTimeParseE fmt timeString + +-- | Just like 'localTimeParse' but the time is automatically converted to global time. +timeParse :: TimeFormat format => format -> String -> Maybe DateTime +timeParse fmt s = localTimeToGlobal `fmap` localTimeParse fmt s diff --git a/Data/Hourglass/Local.hs b/Data/Hourglass/Local.hs --- a/Data/Hourglass/Local.hs +++ b/Data/Hourglass/Local.hs @@ -14,10 +14,13 @@ ( -- * Local time -- ** Local time type - LocalTime(..) + LocalTime -- ** Local time creation and manipulation , localTime + , localTimeUnwrap , localTimeToGlobal + , localTimeFromGlobal + , localTimeGetTimezone , localTimeSetTimezone , localTimeConvert ) where @@ -28,8 +31,9 @@ -- | Local time representation -- --- this is a loca time representation augmented by a timezone +-- this is a time representation augmented by a timezone -- to get back to a global time, the timezoneOffset needed to be added to the local time. +-- data LocalTime t = LocalTime { localTimeUnwrap :: t -- ^ unwrap the LocalTime value. the time value is local. , localTimeGetTimezone :: TimezoneOffset -- ^ get the timezone associated with LocalTime @@ -53,25 +57,23 @@ instance Functor LocalTime where fmap f (LocalTime t tz) = LocalTime (f t) tz -instance Time t => Timeable (LocalTime t) where - timeGetElapsedP (LocalTime t _) = timeGetElapsedP t - timeGetElapsed (LocalTime t _) = timeGetElapsed t - timeGetTimezone (LocalTime _ tz) = Just tz - timeGetNanoSeconds (LocalTime t _) = timeGetNanoSeconds t - -- | Create a local time type from a timezone and a time type. -- --- the time value is converted to represent local time +-- The time value is assumed to be local to the timezone offset set, +-- so no transformation is done. localTime :: Time t => TimezoneOffset -> t -> LocalTime t -localTime tz t = LocalTime (timeConvert t') tz - where currentTz = maybe (TimezoneOffset 0) id $ timeGetTimezone t - t' = elapsedTimeAddSecondsP (timeGetElapsedP t) diffTz - diffTz = timezoneOffsetToSeconds tz - timezoneOffsetToSeconds currentTz +localTime tz t = LocalTime t tz -- | Get back a global time value localTimeToGlobal :: Time t => LocalTime t -> t -localTimeToGlobal (LocalTime local tz) = timeConvert $ elapsedTimeAddSecondsP (timeGetElapsedP local) tzSecs +localTimeToGlobal (LocalTime local tz) + | tz == TimezoneOffset 0 = local + | otherwise = timeConvert $ elapsedTimeAddSecondsP (timeGetElapsedP local) tzSecs where tzSecs = negate $ timezoneOffsetToSeconds tz + +-- | create a local time value from a global one +localTimeFromGlobal :: Time t => t -> LocalTime t +localTimeFromGlobal t = localTime (TimezoneOffset 0) t -- | Change the timezone, and adjust the local value to represent the new local value. localTimeSetTimezone :: Time t => TimezoneOffset -> LocalTime t -> LocalTime t diff --git a/Data/Hourglass/Time.hs b/Data/Hourglass/Time.hs --- a/Data/Hourglass/Time.hs +++ b/Data/Hourglass/Time.hs @@ -30,7 +30,9 @@ , timeGetTimeOfDay -- * Arithmetic - , TimeDiff(..) + , Duration(..) + , Period(..) + , TimeInterval(..) , timeAdd , timeDiff , timeDiffP @@ -71,13 +73,6 @@ timeGetNanoSeconds :: t -> NanoSeconds timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t - -- | return the time zone offset in minute. - -- - -- If the time is not a local time representation (offseted by timezone), - -- then Nothing should be returned. - timeGetTimezone :: t -> Maybe TimezoneOffset - timeGetTimezone _ = Nothing - -- | Represent time types that can be created from other time types. -- -- Every conversion happens throught ElapsedP or Elapsed types. @@ -140,7 +135,7 @@ -- * '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 #-} @@ -150,7 +145,7 @@ -- 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 #-} @@ -159,7 +154,7 @@ -- 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 #-} @@ -168,17 +163,17 @@ -- 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 values with time units to a time representation and returns this new time representation +-- | add some time interval to a time representation and returns this new time representation -- -- example: -- --- > t1 `timeAdd` mempty { timeDiffHours = 12 } -timeAdd :: Time t => t -> TimeDiff -> t -timeAdd t td = timeFromElapsedP $ elapsedTimeAddP (timeGetElapsedP t) td +-- > 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 -- diff --git a/Data/Hourglass/Types.hs b/Data/Hourglass/Types.hs --- a/Data/Hourglass/Types.hs +++ b/Data/Hourglass/Types.hs @@ -12,19 +12,23 @@ -- and int types for years. -- -- Most units use the unix epoch referential, but by no means reduce portability. --- the unix referencial works under the Windows platform or any other platforms. +-- the unix referential works under the Windows platform or any other platforms. -- module Data.Hourglass.Types ( -- * Time units NanoSeconds(..) , Seconds(..) + , Minutes(..) + , Hours(..) + , TimeInterval(..) -- * Time enumeration , Month(..) , WeekDay(..) -- * Timezone , TimezoneOffset(..) , timezoneOffsetToSeconds + , timezone_UTC -- * Computer friendly format -- ** Unix elapsed , Elapsed(..) @@ -42,14 +46,22 @@ import Control.DeepSeq import Data.Hourglass.Utils (pad2) +class TimeInterval i where + toSeconds :: i -> Seconds + fromSeconds :: Seconds -> (i, Seconds) + -- | Nanoseconds -newtype NanoSeconds = NanoSeconds Int +newtype NanoSeconds = NanoSeconds Int64 deriving (Read,Eq,Ord,Num,Data,Typeable,NFData) instance Show NanoSeconds where show (NanoSeconds v) = shows v "ns" --- | Number of seconds without a referencial. +instance TimeInterval NanoSeconds where + toSeconds (NanoSeconds ns) = Seconds (ns `div` 1000000000) + fromSeconds (Seconds s) = (NanoSeconds (s * 1000000000), 0) + +-- | Number of seconds without a referential. -- -- Can hold a number between [-2^63,2^63-1], which should -- be good for some billions of years. @@ -58,11 +70,39 @@ -- currently used, seconds should be in the range [-2^55,2^55-1], -- which is good for only 1 billion of year. newtype Seconds = Seconds Int64 - deriving (Read,Eq,Ord,Num,Data,Typeable,NFData) + deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData) instance Show Seconds where show (Seconds s) = shows s "s" +instance TimeInterval Seconds where + toSeconds = id + fromSeconds s = (s,0) + +-- | Number of minutes without a referential. +newtype Minutes = Minutes Int64 + deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData) + +instance Show Minutes where + show (Minutes s) = shows s "m" + +instance TimeInterval Minutes where + toSeconds (Minutes m) = Seconds (m * 60) + fromSeconds (Seconds s) = (Minutes m, Seconds s') + where (m, s') = s `divMod` 60 + +-- | Number of hours without a referential. +newtype Hours = Hours Int64 + deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData) + +instance Show Hours where + show (Hours s) = shows s "h" + +instance TimeInterval Hours where + toSeconds (Hours h) = Seconds (h * 3600) + fromSeconds (Seconds s) = (Hours h, Seconds s') + where (h, s') = s `divMod` 3600 + -- | A number of seconds elapsed since the unix epoch. newtype Elapsed = Elapsed Seconds deriving (Read,Eq,Ord,Num,Data,Typeable,NFData) @@ -131,9 +171,10 @@ -- LocalTime t (-300) = t represent a time at UTC-5 -- LocalTime t (+480) = t represent a time at UTC+8 -- +-- should be between -11H and +14H newtype TimezoneOffset = TimezoneOffset { timezoneOffsetToMinutes :: Int -- ^ return the number of minutes - } deriving (Eq,Ord,Data,Typeable) + } deriving (Eq,Ord,Data,Typeable,NFData) -- | Return the number of seconds associated with a timezone timezoneOffsetToSeconds :: TimezoneOffset -> Seconds @@ -144,10 +185,14 @@ concat [(if tz < 0 then "-" else "+"), pad2 tzH, pad2 tzM] where (tzH, tzM) = abs tz `divMod` 60 +-- | The UTC timezone. offset of 0 +timezone_UTC :: TimezoneOffset +timezone_UTC = TimezoneOffset 0 + -- | human date representation using common calendar data Date = Date { dateYear :: {-# UNPACK #-} !Int -- ^ year (Common Era) - , dateMonth :: !Month -- ^ month of the year + , dateMonth :: !Month -- ^ month of the year , dateDay :: {-# UNPACK #-} !Int -- ^ day of the month, between 1 to 31 } deriving (Show,Eq,Ord,Data,Typeable) @@ -156,9 +201,9 @@ -- | human time representation of hour, minutes, seconds in a day. data TimeOfDay = TimeOfDay - { todHour :: {-# UNPACK #-} !Int -- ^ hours, between 0 and 23 - , todMin :: {-# UNPACK #-} !Int -- ^ minutes, between 0 and 59 - , todSec :: {-# UNPACK #-} !Int -- ^ seconds, between 0 and 59. 60 when having leap second */ + { todHour :: {-# UNPACK #-} !Hours -- ^ hours, between 0 and 23 + , todMin :: {-# UNPACK #-} !Minutes -- ^ minutes, between 0 and 59 + , todSec :: {-# UNPACK #-} !Seconds -- ^ seconds, between 0 and 59. 60 when having leap second */ , todNSec :: {-# UNPACK #-} !NanoSeconds -- ^ nanoseconds, between 0 and 999999999 */ } deriving (Show,Eq,Ord,Data,Typeable) diff --git a/System/Hourglass.hs b/System/Hourglass.hs --- a/System/Hourglass.hs +++ b/System/Hourglass.hs @@ -14,6 +14,8 @@ , timeCurrentP -- * Current time in human friendly DateTime format , dateCurrent + , localDateCurrent + , localDateCurrentAt -- * System timezone , timezoneCurrent ) where @@ -21,6 +23,7 @@ import Control.Applicative import Data.Hourglass.Types import Data.Hourglass.Time +import Data.Hourglass.Local import Data.Hourglass.Internal (systemGetElapsedP, systemGetElapsed, systemGetTimezone) -- | Get the current elapsed seconds since epoch @@ -31,13 +34,21 @@ timeCurrentP :: IO ElapsedP timeCurrentP = systemGetElapsedP --- | Get the current time +-- | Get the current global date -- -- This is equivalent to: -- -- > timeGetDateTimeOfDay `fmap` timeCurrentP dateCurrent :: IO DateTime dateCurrent = timeGetDateTimeOfDay <$> timeCurrentP + +-- | Get the localized date by using 'timezoneCurrent' and 'dateCurrent' +localDateCurrent :: IO (LocalTime DateTime) +localDateCurrent = localTime <$> timezoneCurrent <*> dateCurrent + +-- | Get the localized date at a specific timezone offset. +localDateCurrentAt :: TimezoneOffset -> IO (LocalTime DateTime) +localDateCurrentAt tz = localTime tz <$> dateCurrent -- | Get the current timezone offset -- diff --git a/hourglass.cabal b/hourglass.cabal --- a/hourglass.cabal +++ b/hourglass.cabal @@ -1,5 +1,5 @@ Name: hourglass -Version: 0.1.2 +Version: 0.2.0 Synopsis: simple performant time related library Description: Simple time library focusing on simple but powerful and performant API @@ -19,6 +19,7 @@ Homepage: https://github.com/vincenthz/hs-hourglass Cabal-Version: >=1.10 extra-source-files: README.md + , CHANGELOG.md , tests/TimeDB.hs Library @@ -52,11 +53,9 @@ Main-is: Tests.hs Build-Depends: base >= 3 && < 5 , mtl - , QuickCheck >= 2 - , HUnit - , test-framework - , test-framework-quickcheck2 - , test-framework-hunit + , tasty + , tasty-quickcheck + , tasty-hunit , hourglass , deepseq -- to test against some other reference diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -8,12 +8,9 @@ import Data.Monoid (mempty) --import Control.DeepSeq -import Test.Framework (defaultMain, testGroup, Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.Framework.Providers.HUnit (testCase) - -import Test.HUnit hiding (Test) -import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit import Data.Word import Data.Int @@ -46,7 +43,7 @@ dateEqual :: LocalTime DateTime -> T.UTCTime -> Bool dateEqual localtime utcTime = and [ fromIntegral y == y', m' == (fromEnum m + 1), d' == d - , h' == h, mi' == mi, sec' == sec ] + , fromIntegral h' == h, fromIntegral mi' == mi, sec' == sec ] where (y',m',d') = T.toGregorian (T.utctDay utcTime) daytime = floor $ T.utctDayTime utcTime (dt', sec')= daytime `divMod` 60 @@ -79,21 +76,20 @@ | v > hiElapsed = v `mod` hiElapsed | v < loElapsed = v `mod` loElapsed | otherwise = error "internal error" - +instance Arbitrary Minutes where + arbitrary = Minutes <$> choose (-1125899906842624, 1125899906842624) +instance Arbitrary Hours where + arbitrary = Hours <$> choose (-1125899906842, 1125899906842) instance Arbitrary NanoSeconds where arbitrary = NanoSeconds <$> choose (0, 100000000) instance Arbitrary Elapsed where arbitrary = Elapsed <$> arbitrary instance Arbitrary TimezoneOffset where arbitrary = TimezoneOffset <$> choose (-11*60,11*60) -instance Arbitrary TimeDiff where - arbitrary = TimeDiff <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> choose (0, 100000) +instance Arbitrary Duration where + arbitrary = Duration <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +instance Arbitrary Period where + arbitrary = Period <$> choose (-29,29) <*> choose (-27,27) <*> choose (-400,400) instance Arbitrary Month where arbitrary = elements [January ..] instance Arbitrary DateTime where @@ -103,9 +99,9 @@ <*> arbitrary <*> choose (1,28) instance Arbitrary TimeOfDay where - arbitrary = TimeOfDay <$> choose (0,23) - <*> choose (0,59) - <*> choose (0,59) + arbitrary = TimeOfDay <$> (Hours <$> choose (0,23)) + <*> (Minutes <$> choose (0,59)) + <*> (Seconds <$> choose (0,59)) <*> arbitrary instance (Time t, Arbitrary t) => Arbitrary (LocalTime t) where arbitrary = localTime <$> arbitrary <*> arbitrary @@ -114,11 +110,11 @@ | expected == got = True | otherwise = error ("expected: " ++ show expected ++ " got: " ++ show got) -tests knowns = +tests knowns = testGroup "hourglass" [ testGroup "known" - [ testGroup "calendar conv" (map toCalendarTest $ zip [1..] (map tuple12 knowns)) - , testGroup "seconds conv" (map toSecondTest $ zip [1..] (map tuple12 knowns)) - , testGroup "weekday" (map toWeekDayTest $ zip [1..] (map tuple13 knowns)) + [ testGroup "calendar conv" (map toCalendarTest $ zip eint (map tuple12 knowns)) + , testGroup "seconds conv" (map toSecondTest $ zip eint (map tuple12 knowns)) + , testGroup "weekday" (map toWeekDayTest $ zip eint (map tuple13 knowns)) ] , testGroup "conversion" [ testProperty "calendar" $ \(e :: Elapsed) -> @@ -130,13 +126,13 @@ , testGroup "localtime" [ testProperty "eq" $ \(l :: LocalTime Elapsed) -> let g = localTimeToGlobal l - in l `eq` localTime (localTimeGetTimezone l) g + in l `eq` localTimeSetTimezone (localTimeGetTimezone l) (localTimeFromGlobal g) , testProperty "set" $ \(l :: LocalTime Elapsed, newTz) -> let l2 = localTimeSetTimezone newTz l in localTimeToGlobal l `eq` localTimeToGlobal l2 ] , testGroup "arithmetic" - [ testProperty "add-diff" $ \(e :: Elapsed, tdiff) -> + [ {-testProperty "add-diff" $ \(e :: Elapsed, tdiff) -> let d@(TimeDiff _ _ day h mi s _) = tdiff { timeDiffYears = 0 , timeDiffMonths = 0 , timeDiffNs = 0 @@ -151,6 +147,7 @@ (d `eq` d') && (toEnum ((fromEnum m+1) `mod` 12) `eq` m') && (if m == December then (y+1) `eq` y' else y `eq` y') + -} ] , testGroup "formating" [ testProperty "iso8601 date" $ \(e :: Elapsed) -> @@ -163,7 +160,7 @@ , testGroup "parsing" [ testProperty "iso8601 date" $ \(e :: Elapsed) -> let fmt = calTimeFormatTimeISO8601 (elapsedToPosixTime e) - ed1 = timeParseE ISO8601_Date fmt + ed1 = localTimeParseE ISO8601_Date fmt md2 = T.parseTime T.defaultTimeLocale fmt "%F" in case (ed1,md2) of (Left _, Nothing) -> error ("both cannot parse: " ++ show fmt) @@ -172,21 +169,21 @@ (Right (_,_), Nothing) -> True -- let (LocalTime tparsed _) = r in error ("time cannot parse: " ++ show tparsed ++ " " ++ fmt) (Right (_, rm), _) -> error ("remaining string after parse: " ++ rm) , testProperty "timezone" $ \tz -> - let r = timeParseE "TZHM" (show tz) in + let r = localTimeParseE "TZHM" (show tz) in case r of Right (localtime, "") -> tz `eq` localTimeGetTimezone localtime _ -> error "Cannot parse timezone" ] ] - where toCalendarTest :: (Int, (Elapsed, DateTime)) -> Test - toCalendarTest (i, (us, dt)) = + where toCalendarTest (i, (us, dt)) = testCase (show i) (dt @=? timeGetDateTimeOfDay us) - toSecondTest :: (Int, (Elapsed, DateTime)) -> Test toSecondTest (i, (us@(Elapsed (Seconds s)), dt)) = testCase (show i ++ "-" ++ show s ++ "s") (us @=? timeGetElapsed dt) - toWeekDayTest :: (Int, (Elapsed, WeekDay)) -> Test toWeekDayTest (i, (us, wd)) = testCase (show i ++ "-" ++ show wd) (wd @=? getWeekDay (dtDate $ timeGetDateTimeOfDay us)) + + eint :: [Int] + eint = [1..] tuple12 (a,b,_,_) = (a,b) tuple13 (a,_,b,_) = (a,b)