hourglass 0.1.2 → 0.2.0
raw patch · 10 files changed
+286/−190 lines, 10 filesdep +tastydep +tasty-hunitdep +tasty-quickcheckdep −HUnitdep −QuickCheckdep −test-frameworkPVP ok
version bump matches the API change (PVP)
Dependencies added: tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: HUnit, QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2
API changes (from Hackage documentation)
- Data.Hourglass: LocalTime :: t -> TimezoneOffset -> LocalTime t
- Data.Hourglass: TimeDiff :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> TimeDiff
- Data.Hourglass: data TimeDiff
- Data.Hourglass: timeDiffDays :: TimeDiff -> Int
- Data.Hourglass: timeDiffHours :: TimeDiff -> Int
- Data.Hourglass: timeDiffMinutes :: TimeDiff -> Int
- Data.Hourglass: timeDiffMonths :: TimeDiff -> Int
- Data.Hourglass: timeDiffNs :: TimeDiff -> Int
- Data.Hourglass: timeDiffSeconds :: TimeDiff -> Int
- Data.Hourglass: timeDiffYears :: TimeDiff -> Int
- Data.Hourglass: timeGetTimezone :: Timeable t => t -> Maybe TimezoneOffset
+ Data.Hourglass: Duration :: !Hours -> !Minutes -> !Seconds -> !NanoSeconds -> Duration
+ Data.Hourglass: Period :: !Int -> !Int -> !Int -> Period
+ Data.Hourglass: class TimeInterval i
+ Data.Hourglass: data Duration
+ Data.Hourglass: data Period
+ Data.Hourglass: durationHours :: Duration -> !Hours
+ Data.Hourglass: durationMinutes :: Duration -> !Minutes
+ Data.Hourglass: durationNs :: Duration -> !NanoSeconds
+ Data.Hourglass: durationSeconds :: Duration -> !Seconds
+ Data.Hourglass: fromSeconds :: TimeInterval i => Seconds -> (i, Seconds)
+ Data.Hourglass: localTimeFromGlobal :: Time t => t -> LocalTime t
+ Data.Hourglass: localTimeParse :: TimeFormat format => format -> String -> Maybe (LocalTime DateTime)
+ Data.Hourglass: localTimeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (LocalTime DateTime, String)
+ Data.Hourglass: localTimePrint :: (TimeFormat format, Timeable t) => format -> LocalTime t -> LocalTime String
+ Data.Hourglass: periodDays :: Period -> !Int
+ Data.Hourglass: periodMonths :: Period -> !Int
+ Data.Hourglass: periodYears :: Period -> !Int
+ Data.Hourglass: toSeconds :: TimeInterval i => i -> Seconds
+ Data.Hourglass.Types: Hours :: Int64 -> Hours
+ Data.Hourglass.Types: Minutes :: Int64 -> Minutes
+ Data.Hourglass.Types: class TimeInterval i
+ Data.Hourglass.Types: fromSeconds :: TimeInterval i => Seconds -> (i, Seconds)
+ Data.Hourglass.Types: instance Data Hours
+ Data.Hourglass.Types: instance Data Minutes
+ Data.Hourglass.Types: instance Enum Hours
+ Data.Hourglass.Types: instance Enum Minutes
+ Data.Hourglass.Types: instance Enum Seconds
+ Data.Hourglass.Types: instance Eq Hours
+ Data.Hourglass.Types: instance Eq Minutes
+ Data.Hourglass.Types: instance Integral Hours
+ Data.Hourglass.Types: instance Integral Minutes
+ Data.Hourglass.Types: instance Integral Seconds
+ Data.Hourglass.Types: instance NFData Hours
+ Data.Hourglass.Types: instance NFData Minutes
+ Data.Hourglass.Types: instance NFData TimezoneOffset
+ Data.Hourglass.Types: instance Num Hours
+ Data.Hourglass.Types: instance Num Minutes
+ Data.Hourglass.Types: instance Ord Hours
+ Data.Hourglass.Types: instance Ord Minutes
+ Data.Hourglass.Types: instance Read Hours
+ Data.Hourglass.Types: instance Read Minutes
+ Data.Hourglass.Types: instance Real Hours
+ Data.Hourglass.Types: instance Real Minutes
+ Data.Hourglass.Types: instance Real Seconds
+ Data.Hourglass.Types: instance Show Hours
+ Data.Hourglass.Types: instance Show Minutes
+ Data.Hourglass.Types: instance TimeInterval Hours
+ Data.Hourglass.Types: instance TimeInterval Minutes
+ Data.Hourglass.Types: instance TimeInterval NanoSeconds
+ Data.Hourglass.Types: instance TimeInterval Seconds
+ Data.Hourglass.Types: instance Typeable Hours
+ Data.Hourglass.Types: instance Typeable Minutes
+ Data.Hourglass.Types: newtype Hours
+ Data.Hourglass.Types: newtype Minutes
+ Data.Hourglass.Types: timezone_UTC :: TimezoneOffset
+ Data.Hourglass.Types: toSeconds :: TimeInterval i => i -> Seconds
+ System.Hourglass: localDateCurrent :: IO (LocalTime DateTime)
+ System.Hourglass: localDateCurrentAt :: TimezoneOffset -> IO (LocalTime DateTime)
- Data.Hourglass: class Timeable t where timeGetElapsed t = e where ElapsedP e _ = timeGetElapsedP t timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t timeGetTimezone _ = Nothing
+ Data.Hourglass: class Timeable t where timeGetElapsed t = e where ElapsedP e _ = timeGetElapsedP t timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t
- Data.Hourglass: timeAdd :: Time t => t -> TimeDiff -> t
+ Data.Hourglass: timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t
- Data.Hourglass: timeParse :: TimeFormat format => format -> String -> Maybe (LocalTime DateTime)
+ Data.Hourglass: timeParse :: TimeFormat format => format -> String -> Maybe DateTime
- Data.Hourglass: timeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (LocalTime DateTime, String)
+ Data.Hourglass: timeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (DateTime, String)
- Data.Hourglass.Types: NanoSeconds :: Int -> NanoSeconds
+ Data.Hourglass.Types: NanoSeconds :: Int64 -> NanoSeconds
- Data.Hourglass.Types: TimeOfDay :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !NanoSeconds -> TimeOfDay
+ Data.Hourglass.Types: TimeOfDay :: {-# UNPACK #-} !Hours -> {-# UNPACK #-} !Minutes -> {-# UNPACK #-} !Seconds -> {-# UNPACK #-} !NanoSeconds -> TimeOfDay
- Data.Hourglass.Types: todHour :: TimeOfDay -> {-# UNPACK #-} !Int
+ Data.Hourglass.Types: todHour :: TimeOfDay -> {-# UNPACK #-} !Hours
- Data.Hourglass.Types: todMin :: TimeOfDay -> {-# UNPACK #-} !Int
+ Data.Hourglass.Types: todMin :: TimeOfDay -> {-# UNPACK #-} !Minutes
- Data.Hourglass.Types: todSec :: TimeOfDay -> {-# UNPACK #-} !Int
+ Data.Hourglass.Types: todSec :: TimeOfDay -> {-# UNPACK #-} !Seconds
Files
- CHANGELOG.md +28/−0
- Data/Hourglass/Calendar.hs +3/−5
- Data/Hourglass/Diff.hs +72/−79
- Data/Hourglass/Format.hs +57/−29
- Data/Hourglass/Local.hs +16/−14
- Data/Hourglass/Time.hs +11/−16
- Data/Hourglass/Types.hs +54/−9
- System/Hourglass.hs +12/−1
- hourglass.cabal +5/−6
- tests/Tests.hs +28/−31
+ CHANGELOG.md view
@@ -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
Data/Hourglass/Calendar.hs view
@@ -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
Data/Hourglass/Diff.hs view
@@ -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 --
Data/Hourglass/Format.hs view
@@ -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
Data/Hourglass/Local.hs view
@@ -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
Data/Hourglass/Time.hs view
@@ -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 --
Data/Hourglass/Types.hs view
@@ -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)
System/Hourglass.hs view
@@ -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 --
hourglass.cabal view
@@ -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
tests/Tests.hs view
@@ -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)