packages feed

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 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)