time-hourglass (empty) → 0.2.12
raw patch · 27 files changed
+2621/−0 lines, 27 filesdep +Win32dep +basedep +bytestringsetup-changed
Dependencies added: Win32, base, bytestring, deepseq, gauge, hourglass, mtl, old-locale, tasty, tasty-hunit, tasty-quickcheck, time
Files
- CHANGELOG.md +18/−0
- Data/Hourglass.hs +41/−0
- Data/Hourglass/Calendar.hs +86/−0
- Data/Hourglass/Compat.hs +38/−0
- Data/Hourglass/Diff.hs +162/−0
- Data/Hourglass/Epoch.hs +129/−0
- Data/Hourglass/Format.hs +403/−0
- Data/Hourglass/Internal.hs +23/−0
- Data/Hourglass/Internal/Unix.hs +168/−0
- Data/Hourglass/Internal/Win.hs +79/−0
- Data/Hourglass/Local.hs +86/−0
- Data/Hourglass/Time.hs +197/−0
- Data/Hourglass/Types.hs +23/−0
- Data/Hourglass/Utils.hs +33/−0
- Data/Hourglass/Zone.hs +52/−0
- LICENSE +27/−0
- README.md +96/−0
- Setup.hs +2/−0
- System/Hourglass.hs +16/−0
- Time/Compat.hs +104/−0
- Time/System.hs +58/−0
- Time/Types.hs +245/−0
- cbits/unix.c +31/−0
- tests/Bench.hs +93/−0
- tests/Tests.hs +265/−0
- tests/TimeDB.hs +36/−0
- time-hourglass.cabal +110/−0
+ CHANGELOG.md view
@@ -0,0 +1,18 @@+Change log for `time-hourglass` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## 0.2.12 + +* Rename `hourglass-0.2.12` package as `time-hourglass-0.2.12`. +* Cabal file specifies `cabal-version: 1.12` (not `>= 1.10`). +* Change maintainer field to `Mike Pilgrem <public@pilgrem.com>`. +* Add `bug-reports` field to Cabal file. +* Reset `CHANGELOG.md`. +* Update `README.md` badges. +* In test-suite `test-hourglass` replace use of `parseTime` (removed from + package `time-1.10`) with `parseTimeM True`.
+ Data/Hourglass.hs view
@@ -0,0 +1,41 @@+-- | +-- Module : Data.Hourglass +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Types and methods for time manipulation. +-- +-- The most basic type for time representation is Elapsed, which +-- represent a number of elapsed seconds since the unix epoch. +-- +-- Every other defined types can be convert to and from Elapsed type: +-- +-- > timeGetElapsed (Date 1 2 3) :: Elapsed +-- > timeFromElapsed 123 :: DateTime +-- +-- Local time is represented by any other time types (Elapsed, Date, DateTime, ..), +-- but augmented by a Timezone offset in minutes. +-- +-- > localTime (Date 2014 May 4) 600 -- local time at UTC+10 of May 4th 2014 +-- +module Data.Hourglass + ( module Data.Hourglass.Time + , module Data.Hourglass.Types + , module Data.Hourglass.Format + , module Data.Hourglass.Local + , module Data.Hourglass.Zone + -- * Calendar misc functions + , isLeapYear + , getWeekDay + , getDayOfTheYear + , daysInMonth + ) where + +import Data.Hourglass.Time +import Data.Hourglass.Format +import Data.Hourglass.Types +import Data.Hourglass.Local +import Data.Hourglass.Zone +import Data.Hourglass.Calendar (isLeapYear, getWeekDay, getDayOfTheYear, daysInMonth)
+ Data/Hourglass/Calendar.hs view
@@ -0,0 +1,86 @@+-- | +-- Module : Data.Hourglass.Calendar +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Misc calendar functions +-- +module Data.Hourglass.Calendar + ( isLeapYear + , getWeekDay + , getDayOfTheYear + , daysInMonth + , dateToUnixEpoch + , dateFromUnixEpoch + , todToSeconds + , dateTimeToUnixEpoch + , dateTimeFromUnixEpoch + , dateTimeFromUnixEpochP + ) where + +import Data.Hourglass.Types +import Data.Hourglass.Internal + +-- | Return if this year is a leap year (366 days) +-- or not (365 days in a year) +isLeapYear :: Int -> Bool +isLeapYear year + | year `mod` 4 /= 0 = False + | year `mod` 100 /= 0 = True + | year `mod` 400 == 0 = True + | otherwise = False + +-- | Return the day of the week a specific date fall in +getWeekDay :: Date -> WeekDay +getWeekDay date = toEnum (d `mod` 7) + where d = daysOfDate date + +-- | return the number of days until the beggining of the month specified for a specific year. +daysUntilMonth :: Int -> Month -> Int +daysUntilMonth y m + | isLeapYear y = leapYears !! fromEnum m + | otherwise = normalYears !! fromEnum m + 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 +-- +-- between 0 and 364. 365 for leap years +getDayOfTheYear :: Date -> Int +getDayOfTheYear (Date y m d) = daysUntilMonth y m + d + +-- | return the number of days before Jan 1st of the year +daysBeforeYear :: Int -> Int +daysBeforeYear year = y * 365 + (y `div` 4) - (y `div` 100) + (y `div` 400) + where y = year - 1 + +-- | Return the number of day since 1 january 1 +daysOfDate :: Date -> Int +daysOfDate (Date y m d) = daysBeforeYear y + daysUntilMonth y m + d + +-- | Return the number of seconds to unix epoch of a date considering hour=0,minute=0,second=0 +dateToUnixEpoch :: Date -> Elapsed +dateToUnixEpoch date = Elapsed $ Seconds (fromIntegral (daysOfDate date - epochDays) * secondsPerDay) + where epochDays = 719163 + secondsPerDay = 86400 -- julian day is 24h + +-- | Return the Date associated with the unix epoch +dateFromUnixEpoch :: Elapsed -> Date +dateFromUnixEpoch e = dtDate $ dateTimeFromUnixEpoch e + +-- | Return the number of seconds from a time structure +todToSeconds :: TimeOfDay -> Seconds +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 +dateTimeToUnixEpoch (DateTime d t) = dateToUnixEpoch d + Elapsed (todToSeconds t)
+ Data/Hourglass/Compat.hs view
@@ -0,0 +1,38 @@+-- | +-- Module : Data.Hourglass.Compat +-- License : BSD-style +-- Maintainer : Nicolas DI PRIMA <nicolas@di-prima.fr> +-- +-- Basic Time conversion compatibility. +-- +-- This module aims to help conversion between the types from the package +-- time to the package hourglass. +-- +-- Example of use (extracted from file Example/Time/Compat.hs): +-- +-- > import Data.Hourglass as H +-- > import Data.Hourglass.Compat as C +-- > import Data.Time as T +-- > +-- > transpose :: T.ZonedTime +-- > -> H.LocalTime H.DateTime +-- > transpose oldTime = +-- > H.localTime +-- > offsetTime +-- > (H.DateTime newDate timeofday) +-- > where +-- > newDate :: H.Date +-- > newDate = C.dateFromTAIEpoch $ T.toModifiedJulianDay $ T.localDay $ T.zonedTimeToLocalTime oldTime +-- > +-- > timeofday :: H.TimeOfDay +-- > timeofday = C.diffTimeToTimeOfDay $ T.timeOfDayToTime $ T.localTimeOfDay $ T.zonedTimeToLocalTime oldTime +-- > +-- > offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime +-- +-- This module will be depreciated in favor of Time.Compat +-- +module Data.Hourglass.Compat + ( module Time.Compat + ) where + +import Time.Compat
+ Data/Hourglass/Diff.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Data.Hourglass.Diff +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- time arithmetic methods +-- +module Data.Hourglass.Diff + ( Duration(..) + , Period(..) + , durationNormalize + , durationFlatten + , elapsedTimeAddSeconds + , elapsedTimeAddSecondsP + , dateAddPeriod + ) where + +import Data.Data +import Data.Monoid +import Data.Hourglass.Types +import Data.Hourglass.Calendar +import Control.DeepSeq + +-- | An amount of conceptual calendar time in terms of years, months and days. +-- +-- This allow calendar manipulation, representing things like days and months +-- irrespective on how long those are related to timezone and daylight changes. +-- +-- See 'Duration' for the time-based equivalent to this class. +data Period = Period + { periodYears :: !Int + , periodMonths :: !Int + , periodDays :: !Int + } deriving (Show,Read,Eq,Ord,Data,Typeable) + +instance NFData Period where + rnf (Period y m d) = y `seq` m `seq` d `seq` () +#if (MIN_VERSION_base(4,11,0)) +instance Semigroup Period where + (<>) (Period y1 m1 d1) (Period y2 m2 d2) = + Period (y1+y2) (m1+m2) (d1+d2) +#endif +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) + +-- | 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 (Show,Read,Eq,Ord,Data,Typeable) + +instance NFData Duration where + rnf (Duration h m s ns) = h `seq` m `seq` s `seq` ns `seq` () +#if (MIN_VERSION_base(4,11,0)) +instance Semigroup Duration where + (<>) (Duration h1 m1 s1 ns1) (Duration h2 m2 s2 ns2) = + Duration (h1+h2) (m1+m2) (s1+s2) (ns1+ns2) +#endif +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 + +-- | Flatten a duration to a number of seconds, nanoseconds +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 + +-- | 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 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 <= 0 = + let (m', y') = if m == 0 + then (11, y - 1) + else (m - 1, y) + in + loop y' m' (daysInMonth y' (toEnum m') + d) + | d <= dMonth = Date y (toEnum m) d + | otherwise = + let newDiff = d - dMonth + in if m == 11 + 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 +elapsedTimeAddSeconds (Elapsed s1) s2 = Elapsed (s1+s2) + +-- | Add a number of seconds to an ElapsedP type +elapsedTimeAddSecondsP :: ElapsedP -> Seconds -> ElapsedP +elapsedTimeAddSecondsP (ElapsedP (Elapsed s1) ns1) s2 = + ElapsedP (Elapsed (s1+s2)) ns1 + +{- disabled for warning purpose. to be implemented + +-- | Duration string to time diff +-- +-- <http://en.wikipedia.org/wiki/ISO_8601#Durations> +-- +-- * P is the duration designator (historically called "period") placed at the start of the duration representation. +-- +-- * Y is the year designator that follows the value for the number of years. +-- +-- * M is the month designator that follows the value for the number of months. +-- +-- * W is the week designator that follows the value for the number of weeks. +-- +-- * D is the day designator that follows the value for the number of days. +-- +-- * T is the time designator that precedes the time components of the representation. +-- +-- * H is the hour designator that follows the value for the number of hours. +-- +-- * M is the minute designator that follows the value for the number of minutes. +-- +-- * S is the second designator that follows the value for the number of seconds. +-- +timeDiffFromDuration :: String -> TimeDiff +timeDiffFromDuration _ = undefined + +timeDiffFromString :: String -> ( + +-- | Human description string to time diff +-- +-- examples: +-- +-- * "1 day" +-- +-- * "2 months, 5 days and 1 second" +-- +timeDiffFromDescription :: String -> TimeDiff +timeDiffFromDescription _ = undefined +-}
+ Data/Hourglass/Epoch.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Data.Hourglass.Epoch +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Epoch tracking +-- +module Data.Hourglass.Epoch + ( + -- * computer time tracking with various epoch + ElapsedSince(..) + , ElapsedSinceP(..) + -- * Epoch + , Epoch(..) + -- ** standard and usual epochs + , UnixEpoch(..) + , WindowsEpoch(..) + ) where + +import Data.Data +import Control.DeepSeq +import Data.Hourglass.Types +import Data.Hourglass.Time + +-- | A number of seconds elapsed since an epoch. +newtype ElapsedSince epoch = ElapsedSince Seconds + deriving (Show,Read,Eq,Ord,Num,Data,Typeable,NFData) + +-- | A number of seconds and nanoseconds elapsed since an epoch. +data ElapsedSinceP epoch = ElapsedSinceP {-# UNPACK #-} !(ElapsedSince epoch) + {-# UNPACK #-} !NanoSeconds + deriving (Show,Read,Eq,Ord,Data,Typeable) + +instance NFData (ElapsedSinceP e) where rnf e = e `seq` () + +instance Num (ElapsedSinceP e) where + (ElapsedSinceP e1 ns1) + (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1+e2) (ns1+ns2) + (ElapsedSinceP e1 ns1) - (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1-e2) (ns1-ns2) + (ElapsedSinceP e1 ns1) * (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1*e2) (ns1*ns2) + negate (ElapsedSinceP e ns) = ElapsedSinceP (negate e) ns + abs (ElapsedSinceP e ns) = ElapsedSinceP (abs e) ns + signum (ElapsedSinceP e ns) = ElapsedSinceP (signum e) ns + fromInteger i = ElapsedSinceP (ElapsedSince (fromIntegral i)) 0 + +-- FIXME instance Real (ElapsedSinceP e) + +-- | epoch related. +-- +-- We use the well known Unix epoch as the +-- reference timezone for doing conversion between epochs. +-- +-- Each methods of this typeclass should not use the actual value, +-- but only get the information needed from the type itself. +class Epoch epoch where + -- | The name of this epoch + epochName :: epoch -> String + + -- | number of seconds of difference with 1st January 1970. + -- + -- a negative number means that this epoch start before + -- the unix epoch. + epochDiffToUnix :: epoch -> Seconds + +-- | Unix Epoch, starting 1st January 1970 +data UnixEpoch = UnixEpoch + deriving (Show,Eq) + +instance Epoch UnixEpoch where + epochName _ = "unix" + epochDiffToUnix _ = 0 + +-- | Windows Epoch, starting 1st January 1601 +data WindowsEpoch = WindowsEpoch + deriving (Show,Eq) + +instance Epoch WindowsEpoch where + epochName _ = "windows" + epochDiffToUnix _ = -11644473600 + +instance Epoch epoch => Timeable (ElapsedSince epoch) where + timeGetElapsedP es = ElapsedP (Elapsed e) 0 + where ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch + timeGetElapsed es = Elapsed e + where ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch + timeGetNanoSeconds _ = 0 + +instance Epoch epoch => Time (ElapsedSince epoch) where + timeFromElapsedP (ElapsedP (Elapsed e) _) = + convertEpoch (ElapsedSince e :: ElapsedSince UnixEpoch) + +instance Epoch epoch => Timeable (ElapsedSinceP epoch) where + timeGetElapsedP es = ElapsedP (Elapsed e) ns + where ElapsedSinceP (ElapsedSince e) ns = convertEpochP es :: ElapsedSinceP UnixEpoch + timeGetNanoSeconds (ElapsedSinceP _ ns) = ns +instance Epoch epoch => Time (ElapsedSinceP epoch) where + timeFromElapsedP (ElapsedP (Elapsed e) ns) = convertEpochP (ElapsedSinceP (ElapsedSince e) ns :: ElapsedSinceP UnixEpoch) + +-- | Convert Elapsed seconds to another epoch with explicit epochs specified +convertEpochWith :: (Epoch e1, Epoch e2) => (e1,e2) -> ElapsedSince e1 -> ElapsedSince e2 +convertEpochWith (e1,e2) (ElapsedSince s1) = ElapsedSince (s1 + diff) + where diff = d1 - d2 + d1 = epochDiffToUnix e1 + d2 = epochDiffToUnix e2 + +-- | Convert Elapsed seconds to another epoch. +-- +-- the actual epochs need to be known somehow by the context, otherwise this function +-- will yield a compilation errors as the epoch are not chosen. +-- +-- If you want to force specific epoch conversion, use convertEpochWith +convertEpoch :: (Epoch e1, Epoch e2) => ElapsedSince e1 -> ElapsedSince e2 +convertEpoch = convertEpochWith (undefined, undefined) + +-- | Convert Precise Elapsed seconds to another epoch with explicit epochs specified +convertEpochPWith :: (Epoch e1, Epoch e2) => (e1,e2) -> ElapsedSinceP e1 -> ElapsedSinceP e2 +convertEpochPWith es (ElapsedSinceP e1 n1) = ElapsedSinceP (convertEpochWith es e1) n1 + +-- | Convert Elapsed seconds to another epoch. +-- +-- the actual epochs need to be known somehow by the context, otherwise this function +-- will yield a compilation errors as the epoch are not chosen. +-- +-- If you want to force specific epoch conversion, use convertEpochWith +convertEpochP :: (Epoch e1, Epoch e2) => ElapsedSinceP e1 -> ElapsedSinceP e2 +convertEpochP = convertEpochPWith (undefined, undefined)
+ Data/Hourglass/Format.hs view
@@ -0,0 +1,403 @@+-- | +-- Module : Data.Hourglass.Format +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Time formatting : printing and parsing +-- +-- Built-in format strings +-- +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} +module Data.Hourglass.Format + ( + -- * Parsing and Printing + -- ** Format strings + TimeFormatElem(..) + , TimeFormatFct(..) + , TimeFormatString(..) + , TimeFormat(..) + -- ** Common built-in formats + , ISO8601_Date(..) + , ISO8601_DateAndTime(..) + -- ** Format methods + , timePrint + , timeParse + , timeParseE + , localTimePrint + , localTimeParse + , localTimeParseE + ) where + +import Data.Hourglass.Types +import Data.Hourglass.Time +import Data.Hourglass.Calendar +import Data.Hourglass.Local +import Data.Hourglass.Utils +import Data.Char (isDigit, ord) +import Data.Int + +-- | All the various formatter that can be part +-- of a time format string +data TimeFormatElem = + Format_Year2 -- ^ 2 digit years (70 is 1970, 69 is 2069) + | Format_Year4 -- ^ 4 digits years + | Format_Year -- ^ any digits years + | Format_Month -- ^ months (1 to 12) + | Format_Month2 -- ^ months padded to 2 chars (01 to 12) + | Format_MonthName_Short -- ^ name of the month short ('Jan', 'Feb' ..) + | Format_DayYear -- ^ day of the year (1 to 365, 366 for leap years) + | Format_Day -- ^ day of the month (1 to 31) + | Format_Day2 -- ^ day of the month (01 to 31) + | Format_Hour -- ^ hours (0 to 23) + | Format_Minute -- ^ minutes (0 to 59) + | Format_Second -- ^ seconds (0 to 59, 60 for leap seconds) + | Format_UnixSecond -- ^ number of seconds since 1 jan 1970. unix epoch. + | Format_MilliSecond -- ^ Milliseconds (000 to 999) + | Format_MicroSecond -- ^ MicroSeconds (000000 to 999999) + | Format_NanoSecond -- ^ NanoSeconds (000000000 to 999999999) + | Format_Precision Int -- ^ sub seconds display with a precision of N digits. with N between 1 and 9 + | Format_TimezoneName -- ^ timezone name (e.g. GMT, PST). not implemented yet + -- | Format_TimezoneOffset -- ^ timeoffset offset (+02:00) + | Format_TzHM_Colon_Z -- ^ zero UTC offset (Z) or timeoffset with colon (+02:00) + | Format_TzHM_Colon -- ^ timeoffset offset with colon (+02:00) + | Format_TzHM -- ^ timeoffset offset (+0200) + | Format_Tz_Offset -- ^ timeoffset in minutes + | Format_Spaces -- ^ one or many space-like chars + | Format_Text Char -- ^ a verbatim char + | Format_Fct TimeFormatFct + deriving (Show,Eq) + +-- | A generic format function composed of a parser and a printer. +data TimeFormatFct = TimeFormatFct + { timeFormatFctName :: String + , timeFormatParse :: DateTime -> String -> Either String (DateTime, String) + , timeFormatPrint :: DateTime -> String + } + +instance Show TimeFormatFct where + show = timeFormatFctName +instance Eq TimeFormatFct where + t1 == t2 = timeFormatFctName t1 == timeFormatFctName t2 + +-- | A time format string, composed of list of 'TimeFormatElem' +newtype TimeFormatString = TimeFormatString [TimeFormatElem] + deriving (Show,Eq) + +-- | A generic class for anything that can be considered a Time Format string. +class TimeFormat format where + toFormat :: format -> TimeFormatString + +-- | ISO8601 Date format string. +-- +-- e.g. 2014-04-05 +data ISO8601_Date = ISO8601_Date + deriving (Show,Eq) + +-- | ISO8601 Date and Time format string. +-- +-- e.g. 2014-04-05T17:25:04+00:00 +-- 2014-04-05T17:25:04Z +data ISO8601_DateAndTime = ISO8601_DateAndTime + deriving (Show,Eq) + +instance TimeFormat [TimeFormatElem] where + toFormat = TimeFormatString + +instance TimeFormat TimeFormatString where + toFormat = id + +instance TimeFormat String where + toFormat = TimeFormatString . toFormatElem + where toFormatElem [] = [] + toFormatElem ('Y':'Y':'Y':'Y':r) = Format_Year4 : toFormatElem r + toFormatElem ('Y':'Y':r) = Format_Year2 : toFormatElem r + toFormatElem ('M':'M':r) = Format_Month2 : toFormatElem r + toFormatElem ('M':'o':'n':r) = Format_MonthName_Short : toFormatElem r + toFormatElem ('M':'I':r) = Format_Minute : toFormatElem r + toFormatElem ('M':r) = Format_Month : toFormatElem r + toFormatElem ('D':'D':r) = Format_Day2 : toFormatElem r + toFormatElem ('H':r) = Format_Hour : toFormatElem r + toFormatElem ('S':r) = Format_Second : toFormatElem r + toFormatElem ('m':'s':r) = Format_MilliSecond : toFormatElem r + toFormatElem ('u':'s':r) = Format_MicroSecond : toFormatElem r + toFormatElem ('μ':r) = Format_MicroSecond : toFormatElem r + toFormatElem ('n':'s':r) = Format_NanoSecond : toFormatElem r + toFormatElem ('p':'1':r) = Format_Precision 1 : toFormatElem r + toFormatElem ('p':'2':r) = Format_Precision 2 : toFormatElem r + toFormatElem ('p':'3':r) = Format_Precision 3 : toFormatElem r + toFormatElem ('p':'4':r) = Format_Precision 4 : toFormatElem r + toFormatElem ('p':'5':r) = Format_Precision 5 : toFormatElem r + toFormatElem ('p':'6':r) = Format_Precision 6 : toFormatElem r + toFormatElem ('p':'7':r) = Format_Precision 7 : toFormatElem r + toFormatElem ('p':'8':r) = Format_Precision 8 : toFormatElem r + toFormatElem ('p':'9':r) = Format_Precision 9 : toFormatElem r + ----------------------------------------------------------- + toFormatElem ('E':'P':'O':'C':'H':r) = Format_UnixSecond : toFormatElem r + ----------------------------------------------------------- + toFormatElem ('T':'Z':'H':'M':r) = Format_TzHM : toFormatElem r + toFormatElem ('T':'Z':'H':':':'M':r) = Format_TzHM_Colon : toFormatElem r + toFormatElem ('T':'Z':'O':'F':'S':r) = Format_Tz_Offset : toFormatElem r + ----------------------------------------------------------- + toFormatElem ('\\':c:r) = Format_Text c : toFormatElem r + toFormatElem (' ':r) = Format_Spaces : toFormatElem r + toFormatElem (c:r) = Format_Text c : toFormatElem r + +instance TimeFormat ISO8601_Date where + toFormat _ = TimeFormatString [Format_Year,dash,Format_Month2,dash,Format_Day2] + where dash = Format_Text '-' + +instance TimeFormat ISO8601_DateAndTime where + toFormat _ = TimeFormatString + [Format_Year,dash,Format_Month2,dash,Format_Day2 -- date + ,Format_Text 'T' + ,Format_Hour,colon,Format_Minute,colon,Format_Second -- time + ,Format_TzHM_Colon_Z -- zero UTC offset (Z) or timezone offset with colon +HH:MM + ] + where dash = Format_Text '-' + colon = Format_Text ':' + +monthFromShort :: String -> Either String Month +monthFromShort str = + case str of + "Jan" -> Right January + "Feb" -> Right February + "Mar" -> Right March + "Apr" -> Right April + "May" -> Right May + "Jun" -> Right June + "Jul" -> Right July + "Aug" -> Right August + "Sep" -> Right September + "Oct" -> Right October + "Nov" -> Right November + "Dec" -> Right December + _ -> Left $ "unknown month: " ++ str + +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) + fmtToString Format_Month2 = pad2 (fromEnum (dateMonth date)+1) + fmtToString Format_Month = show (fromEnum (dateMonth date)+1) + fmtToString Format_MonthName_Short = take 3 $ show (dateMonth date) + fmtToString Format_Day2 = pad2 (dateDay date) + fmtToString Format_Day = show (dateDay date) + fmtToString Format_Hour = pad2 (fromIntegral (todHour tm) :: Int) + fmtToString Format_Minute = pad2 (fromIntegral (todMin tm) :: Int) + fmtToString Format_Second = pad2 (fromIntegral (todSec tm) :: Int) + fmtToString Format_MilliSecond = padN 3 (ns `div` 1000000) + fmtToString Format_MicroSecond = padN 3 ((ns `div` 1000) `mod` 1000) + fmtToString Format_NanoSecond = padN 3 (ns `mod` 1000) + fmtToString (Format_Precision n) + | n >= 1 && n <= 9 = padN n (ns `div` (10 ^ (9 - n))) + | otherwise = error "invalid precision format" + fmtToString Format_UnixSecond = show unixSecs + fmtToString Format_TimezoneName = "" -- + fmtToString Format_Tz_Offset = show tz + fmtToString Format_TzHM = show tzOfs + fmtToString Format_TzHM_Colon_Z + | tz == 0 = "Z" + | otherwise = fmtToString Format_TzHM_Colon + fmtToString Format_TzHM_Colon = + let (tzH, tzM) = abs tz `divMod` 60 + sign = if tz < 0 then "-" else "+" + in sign ++ pad2 tzH ++ ":" ++ pad2 tzM + fmtToString Format_Spaces = " " + fmtToString (Format_Text c) = [c] + fmtToString f = error ("implemented printing format: " ++ show f) + + (TimeFormatString fmtElems) = toFormat fmt + + (Elapsed (Seconds unixSecs)) = timeGetElapsed t + (DateTime date tm) = timeGetDateTimeOfDay t + (NanoSeconds ns) = timeGetNanoSeconds t + +-- | 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 + -> String -- ^ the resulting local time string +localTimePrint fmt lt = localTimeUnwrap $ 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 +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 + + 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 + Left err -> Left (x, err) + Right (nacc, s') -> loop nacc xs s' + + processOne _ _ [] = Left "empty" + processOne acc (Format_Text c) (x:xs) + | c == x = Right (acc, xs) + | otherwise = Left ("unexpected char, got: " ++ show c) + + processOne acc Format_Year s = + onSuccess (\y -> modDate (setYear y) acc) $ isNumber s + processOne acc Format_Year4 s = + onSuccess (\y -> modDate (setYear y) acc) $ getNDigitNum 4 s + processOne acc Format_Year2 s = onSuccess + (\y -> let year = if y < 70 then y + 2000 else y + 1900 in modDate (setYear year) acc) + $ getNDigitNum 2 s + processOne acc Format_Month2 s = + onSuccess (\m -> modDate (setMonth $ toEnum ((fromIntegral m - 1) `mod` 12)) acc) $ getNDigitNum 2 s + processOne acc Format_MonthName_Short s = + onSuccess (\m -> modDate (setMonth m) acc) $ getMonth s + processOne acc Format_Day2 s = + onSuccess (\d -> modDate (setDay d) acc) $ getNDigitNum 2 s + processOne acc Format_Hour s = + onSuccess (\h -> modTime (setHour h) acc) $ getNDigitNum 2 s + processOne acc Format_Minute s = + onSuccess (\mi -> modTime (setMin mi) acc) $ getNDigitNum 2 s + processOne acc Format_Second s = + onSuccess (\sec -> modTime (setSec sec) acc) $ getNDigitNum 2 s + processOne acc Format_MilliSecond s = + onSuccess (\ms -> modTime (setNsMask (6,3) ms) acc) $ getNDigitNum 3 s + processOne acc Format_MicroSecond s = + onSuccess (\us -> modTime (setNsMask (3,3) us) acc) $ getNDigitNum 3 s + processOne acc Format_NanoSecond s = + onSuccess (\ns -> modTime (setNsMask (0,3) ns) acc) $ getNDigitNum 3 s + processOne acc (Format_Precision p) s = + onSuccess (\num -> modTime (setNS num) acc) $ getNDigitNum p s + processOne acc Format_UnixSecond s = + onSuccess (\sec -> + let newDate = dateTimeFromUnixEpochP $ flip ElapsedP 0 $ Elapsed $ Seconds sec + in modDT (const newDate) acc) $ isNumber s + processOne acc Format_TzHM_Colon_Z a@(c:s) + | c == 'Z' = Right (acc, s) + | otherwise = processOne acc Format_TzHM_Colon a + processOne acc Format_TzHM_Colon (c:s) = + parseHMSign True acc c s + processOne acc Format_TzHM (c:s) = + parseHMSign False acc c s + + processOne acc Format_Spaces (' ':s) = Right (acc, s) + -- catch all for unimplemented format. + processOne _ f _ = error ("unimplemened parsing format: " ++ show f) + + parseHMSign expectColon acc signChar afterSign = + case signChar of + '+' -> parseHM False expectColon afterSign acc + '-' -> parseHM True expectColon afterSign acc + _ -> parseHM False expectColon (signChar:afterSign) acc + + parseHM isNeg True (h1:h2:':':m1:m2:xs) acc + | allDigits [h1,h2,m1,m2] = let tz = toTZ isNeg h1 h2 m1 m2 + in Right (modTZ (const tz) acc, xs) + | otherwise = Left ("not digits chars: " ++ show [h1,h2,m1,m2]) + parseHM isNeg False (h1:h2:m1:m2:xs) acc + | allDigits [h1,h2,m1,m2] = let tz = toTZ isNeg h1 h2 m1 m2 + in Right (modTZ (const tz) acc, xs) + | otherwise = Left ("not digits chars: " ++ show [h1,h2,m1,m2]) + parseHM _ _ _ _ = Left "invalid timezone format" + + toTZ isNeg h1 h2 m1 m2 = TimezoneOffset ((if isNeg then negate else id) minutes) + where minutes = (toInt [h1,h2] * 60) + toInt [m1,m2] + + onSuccess f (Right (v, s')) = Right (f v, s') + onSuccess _ (Left s) = Left s + + isNumber :: Num a => String -> Either String (a, String) + isNumber s = + case span isDigit s of + ("",s2) -> Left ("no digits chars:" ++ s2) + (s1,s2) -> Right (toInt s1, s2) + + getNDigitNum :: Int -> String -> Either String (Int64, String) + getNDigitNum n s = + case getNChar n s of + Left err -> Left err + Right (s1, s2) | not (allDigits s1) -> Left ("not a digit chars in " ++ show s1) + | otherwise -> Right (toInt s1, s2) + + getMonth :: String -> Either String (Month, String) + getMonth s = + getNChar 3 s >>= \(s1, s2) -> monthFromShort s1 >>= \m -> Right (m, s2) + + getNChar :: Int -> String -> Either String (String, String) + getNChar n s + | length s1 < n = Left ("not enough chars: expecting " ++ show n ++ " got " ++ show s1) + | otherwise = Right (s1, s2) + where + (s1, s2) = splitAt n s + + toInt :: Num a => String -> a + toInt = foldl (\acc w -> acc * 10 + fromIntegral (ord w - ord '0')) 0 + + allDigits = and . map isDigit + + ini = (DateTime (Date 0 (toEnum 0) 0) (TimeOfDay 0 0 0 0), TimezoneOffset 0) + + 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 :: Int64 -> Date -> Date + setYear y (Date _ m d) = Date (fromIntegral y) m d + setMonth m (Date y _ d) = Date y m d + setDay d (Date y m _) = Date y m (fromIntegral d) + setHour h (TimeOfDay _ m s ns) = TimeOfDay (Hours h) m s ns + setMin m (TimeOfDay h _ s ns) = TimeOfDay h (Minutes m) s ns + setSec s (TimeOfDay h m _ ns) = TimeOfDay h m (Seconds s) ns + setNS v (TimeOfDay h m s _ ) = TimeOfDay h m s (NanoSeconds v) + + setNsMask :: (Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay + setNsMask (shift, mask) val (TimeOfDay h mins seconds (NanoSeconds ns)) = + let (nsD,keepL) = ns `divMod` s + (keepH,_) = nsD `divMod` m + v = ((keepH * m + fromIntegral val) * s) + keepL + in TimeOfDay h mins seconds (NanoSeconds v) + where s = 10 ^ shift + m = 10 ^ mask +-- | Try parsing a string as time using the format explicitely specified +-- +-- 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/Internal.hs view
@@ -0,0 +1,23 @@+-- | +-- Module : Data.Hourglass.Internal +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- System lowlevel functions +-- +{-# LANGUAGE CPP #-} +module Data.Hourglass.Internal + ( dateTimeFromUnixEpochP + , dateTimeFromUnixEpoch + , systemGetTimezone + , systemGetElapsed + , systemGetElapsedP + ) where + +#ifdef WINDOWS +import Data.Hourglass.Internal.Win +#else +import Data.Hourglass.Internal.Unix +#endif
+ Data/Hourglass/Internal/Unix.hs view
@@ -0,0 +1,168 @@+-- | +-- Module : Data.Hourglass.Internal.Unix +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Time lowlevel helpers for the unix operating system +-- +-- depend on localtime_r and gmtime_r. +-- Some obscure unix system might not support them. +-- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyDataDecls #-} +module Data.Hourglass.Internal.Unix + ( dateTimeFromUnixEpochP + , dateTimeFromUnixEpoch + , systemGetTimezone + , systemGetElapsed + , systemGetElapsedP + ) where + +import Control.Applicative +import Foreign.C.Types +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Data.Hourglass.Types +import System.IO.Unsafe + +-- | convert a unix epoch precise to DateTime +dateTimeFromUnixEpochP :: ElapsedP -> DateTime +dateTimeFromUnixEpochP (ElapsedP e ns) = fromCP ns $ rawGmTime e + +-- | convert a unix epoch to DateTime +dateTimeFromUnixEpoch :: Elapsed -> DateTime +dateTimeFromUnixEpoch e = fromC $ rawGmTime e + +-- | return the timezone offset in minutes +systemGetTimezone :: IO TimezoneOffset +systemGetTimezone = TimezoneOffset . fromIntegral . flip div 60 <$> localTime 0 + +---------------------------------------------------------------------------------------- +-- | return the current elapsedP +systemGetElapsedP :: IO ElapsedP +systemGetElapsedP = allocaBytesAligned sofTimespec 8 $ \ptr -> do + c_clock_get ptr + toElapsedP <$> peek (castPtr ptr) <*> peekByteOff (castPtr ptr) sofCTime + where sofTimespec = sofCTime + sofCLong + sofCTime = sizeOf (0 :: CTime) + sofCLong = sizeOf (0 :: CLong) +#if (MIN_VERSION_base(4,5,0)) + toElapsedP :: CTime -> CLong -> ElapsedP + toElapsedP (CTime sec) nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec) +#else + toElapsedP :: CLong -> CLong -> ElapsedP + toElapsedP sec nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec) +#endif + +-- | return the current elapsed +systemGetElapsed :: IO Elapsed +systemGetElapsed = allocaBytesAligned sofTimespec 8 $ \ptr -> do + c_clock_get ptr + toElapsed <$> peek (castPtr ptr) + where sofTimespec = sizeOf (0 :: CTime) + sizeOf (0 :: CLong) +#if (MIN_VERSION_base(4,5,0)) + toElapsed :: CTime -> Elapsed + toElapsed (CTime sec) = Elapsed $ Seconds (fromIntegral sec) +#else + toElapsed :: CLong -> Elapsed + toElapsed sec = Elapsed $ Seconds (fromIntegral sec) +#endif + +foreign import ccall unsafe "hourglass_clock_calendar" + c_clock_get :: Ptr CLong -> IO () + +#if (MIN_VERSION_base(4,5,0)) +foreign import ccall unsafe "gmtime_r" + c_gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) + +foreign import ccall unsafe "localtime_r" + c_localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +#else +foreign import ccall unsafe "gmtime_r" + c_gmtime_r :: Ptr CLong -> Ptr CTm -> IO (Ptr CTm) + +foreign import ccall unsafe "localtime_r" + c_localtime_r :: Ptr CLong -> Ptr CTm -> IO (Ptr CTm) +#endif + +-- | Return a global time's struct tm based on the number of elapsed second since unix epoch. +rawGmTime :: Elapsed -> CTm +rawGmTime (Elapsed (Seconds s)) = unsafePerformIO callTime + where callTime = + alloca $ \ctmPtr -> do + alloca $ \ctimePtr -> do + poke ctimePtr ctime + r <- c_gmtime_r ctimePtr ctmPtr + if r == nullPtr + then error "gmTime failed" + else peek ctmPtr + ctime = fromIntegral s +{-# NOINLINE rawGmTime #-} + +-- | Return a local time's gmtoff (seconds east of UTC) +-- +-- use the ill defined gmtoff (at offset 40) that might or might not be +-- available for your platform. worst case scenario it's not initialized +-- properly. +localTime :: Elapsed -> IO CLong +localTime (Elapsed (Seconds s)) = callTime + where callTime = + alloca $ \ctmPtr -> do + alloca $ \ctimePtr -> do + poke ctimePtr ctime + r <- c_localtime_r ctimePtr ctmPtr + if r == nullPtr + then error "localTime failed" + else peekByteOff ctmPtr 40 + ctime = fromIntegral s + +-- | Represent the beginning of struct tm +data CTm = CTm + { ctmSec :: CInt + , ctmMin :: CInt + , ctmHour :: CInt + , ctmMDay :: CInt + , ctmMon :: CInt + , ctmYear :: CInt + } deriving (Show,Eq) + +-- | Convert a C structure to a DateTime structure +fromC :: CTm -> DateTime +fromC ctm = DateTime date time + where date = Date + { dateYear = fromIntegral $ ctmYear ctm + 1900 + , dateMonth = toEnum $ fromIntegral $ ctmMon ctm + , dateDay = fromIntegral $ ctmMDay ctm + } + time = TimeOfDay + { todHour = fromIntegral $ ctmHour ctm + , todMin = fromIntegral $ ctmMin ctm + , todSec = fromIntegral $ ctmSec ctm + , todNSec = 0 + } + +-- | Similar to 'fromC' except with nanosecond precision +fromCP :: NanoSeconds -> CTm -> DateTime +fromCP ns ctm = DateTime d (t { todNSec = ns }) + where (DateTime d t) = fromC ctm + +instance Storable CTm where + alignment _ = 8 + sizeOf _ = 60 -- account for 9 ints, alignment + 2 unsigned long at end. + peek ptr = do + CTm <$> peekByteOff intPtr 0 + <*> peekByteOff intPtr 4 + <*> peekByteOff intPtr 8 + <*> peekByteOff intPtr 12 + <*> peekByteOff intPtr 16 + <*> peekByteOff intPtr 20 + where intPtr = castPtr ptr + poke ptr (CTm f0 f1 f2 f3 f4 f5) = do + mapM_ (uncurry (pokeByteOff intPtr)) + [(0,f0), (4,f1), (8,f2), (12,f3), (16,f4), (20,f5)] + --pokeByteOff (castPtr ptr) 36 f9 + where intPtr = castPtr ptr
+ Data/Hourglass/Internal/Win.hs view
@@ -0,0 +1,79 @@+-- | +-- Module : Data.Hourglass.Internal.Win +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Time lowlevel helpers binding to Windows +-- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP #-} +module Data.Hourglass.Internal.Win + ( dateTimeFromUnixEpochP + , dateTimeFromUnixEpoch + , systemGetTimezone + , systemGetElapsed + , systemGetElapsedP + ) where + +import System.IO.Unsafe +import System.Win32.Time +import Data.Hourglass.Types +import Data.Int (Int64) + +unixDiff :: Int64 +unixDiff = 11644473600 + +toFileTime :: Elapsed -> FILETIME +toFileTime (Elapsed (Seconds s)) = FILETIME val + where val = fromIntegral (s + unixDiff) * 10000000 + +toElapsedP :: FILETIME -> ElapsedP +toElapsedP (FILETIME w) = ElapsedP (Elapsed $ Seconds s) (NanoSeconds ns) + where (sWin, hundredNs) = w `divMod` 10000000 + ns = fromIntegral (hundredNs * 100) + s = fromIntegral sWin - unixDiff + +toElapsed :: FILETIME -> Elapsed +toElapsed (FILETIME w) = Elapsed (Seconds s) + where s = fromIntegral (fst (w `divMod` 10000000)) - unixDiff + +callSystemTime :: Elapsed -> SYSTEMTIME +callSystemTime e = unsafePerformIO (fileTimeToSystemTime (toFileTime e)) +{-# NOINLINE callSystemTime #-} + +dateTimeFromUnixEpochP :: ElapsedP -> DateTime +dateTimeFromUnixEpochP (ElapsedP e ns) = toDateTime $ callSystemTime e + where toDateTime (SYSTEMTIME wY wM _ wD wH wMin wS _) = + DateTime (Date (fi wY) (toEnum $ fi $ wM - 1) (fi wD)) + (TimeOfDay (fi wH) (fi wMin) (fi wS) ns) + fi :: (Integral a, Num b) => a -> b + fi = fromIntegral + +dateTimeFromUnixEpoch :: Elapsed -> DateTime +dateTimeFromUnixEpoch e = toDateTime $ callSystemTime e + where toDateTime (SYSTEMTIME wY wM _ wD wH wMin wS _) = + DateTime (Date (fi wY) (toEnum $ fi $ wM - 1) (fi wD)) + (TimeOfDay (fi wH) (fi wMin) (fi wS) 0) + fi :: (Integral a, Num b) => a -> b + fi = fromIntegral + +systemGetTimezone :: IO TimezoneOffset +systemGetTimezone = do + (tzMode,tzInfo) <- getTimeZoneInformation + case tzMode of + TzIdDaylight -> return $ toTO (tziBias tzInfo + tziDaylightBias tzInfo) + TzIdStandard -> return $ toTO (tziBias tzInfo + tziStandardBias tzInfo) + TzIdUnknown -> return $ toTO (tziBias tzInfo) + where + -- a negative value represent value how to go from local to UTC, + -- whereas TimezoneOffset represent the offset to go from UTC to local. + -- here we negate the bias to get the proper value represented. + toTO = TimezoneOffset . fromIntegral . negate + +systemGetElapsedP :: IO ElapsedP +systemGetElapsedP = toElapsedP `fmap` getSystemTimeAsFileTime + +systemGetElapsed :: IO Elapsed +systemGetElapsed = toElapsed `fmap` getSystemTimeAsFileTime
+ Data/Hourglass/Local.hs view
@@ -0,0 +1,86 @@+-- | +-- Module : Data.Hourglass.Local +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Local time = global time + timezone +-- +{-# LANGUAGE FlexibleInstances #-} +module Data.Hourglass.Local + ( + -- * Local time + -- ** Local time type + LocalTime + -- ** Local time creation and manipulation + , localTime + , localTimeUnwrap + , localTimeToGlobal + , localTimeFromGlobal + , localTimeGetTimezone + , localTimeSetTimezone + , localTimeConvert + ) where + +import Data.Hourglass.Types +import Data.Hourglass.Time +import Data.Hourglass.Diff + +-- | Local time representation +-- +-- 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 + } + +-- FIXME add instance Read too. + +instance Show t => Show (LocalTime t) where + show (LocalTime t tz) = show t ++ show tz +instance Eq t => Eq (LocalTime t) where + LocalTime t1 tz1 == LocalTime t2 tz2 = tz1 == tz2 && t1 == t2 + +instance (Ord t, Time t) => Ord (LocalTime t) where + compare l1@(LocalTime g1 tz1) l2@(LocalTime g2 tz2) = + case compare tz1 tz2 of + EQ -> compare g1 g2 + _ -> let t1 = localTimeToGlobal l1 + t2 = localTimeToGlobal l2 + in compare t1 t2 + +instance Functor LocalTime where + fmap f (LocalTime t tz) = LocalTime (f t) tz + +-- | Create a local time type from a timezone and a time type. +-- +-- 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 t tz + +-- | Get back a global time value +localTimeToGlobal :: Time t => LocalTime t -> t +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 = localTime (TimezoneOffset 0) + +-- | Change the timezone, and adjust the local value to represent the new local value. +localTimeSetTimezone :: Time t => TimezoneOffset -> LocalTime t -> LocalTime t +localTimeSetTimezone tz currentLocal@(LocalTime t currentTz) + | diffTz == 0 = currentLocal + | otherwise = LocalTime (timeConvert t') tz + where t' = elapsedTimeAddSecondsP (timeGetElapsedP t) diffTz + diffTz = timezoneOffsetToSeconds tz - timezoneOffsetToSeconds currentTz + +-- | convert the local time representation to another time representation determined by context. +localTimeConvert :: (Time t1, Time t2) => LocalTime t1 -> LocalTime t2 +localTimeConvert = fmap timeConvert
+ Data/Hourglass/Time.hs view
@@ -0,0 +1,197 @@+-- | +-- Module : Data.Hourglass.Time +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- generic time representation interface to allow +-- arbitrary conversion between different time representation +-- +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Data.Hourglass.Time + ( + -- * Generic time classes + Time(..) + , Timeable(..) + + -- * Elapsed time + , Elapsed(..) + , ElapsedP(..) + + -- * Generic conversion + , timeConvert + + -- * Date and Time + , timeGetDate + , timeGetDateTimeOfDay + , timeGetTimeOfDay + + -- * Arithmetic + , Duration(..) + , Period(..) + , TimeInterval(..) + , timeAdd + , timeDiff + , timeDiffP + , dateAddPeriod + ) where + +import Data.Data () +import Data.Hourglass.Types +import Data.Hourglass.Calendar +import Data.Hourglass.Diff +import Foreign.C.Types (CTime(..)) + +-- | Timeable represent every type that can be made to look like time types. +-- +-- * can be converted to ElapsedP and Elapsed +-- +-- * optionally have a timezone associated +-- +-- * have nanoseconds accessor (which can return 0 when the type is not more precise than seconds) +-- +class Timeable t where + -- | convert a time representation to the number of elapsed seconds and nanoseconds to a specific epoch + timeGetElapsedP :: t -> ElapsedP + + -- | convert a time representation to the number of elapsed seconds to a specific epoch. + -- + -- defaults to timeGetElapsedP unless defined explicitely by an instance + timeGetElapsed :: t -> Elapsed + timeGetElapsed t = e where ElapsedP e _ = timeGetElapsedP t + + -- | return the number of optional nanoseconds. + -- + -- If the underlaying type is not precise enough to record nanoseconds + -- (or any variant between seconds and nanoseconds), 0 should be returned + -- + -- defaults to 'timeGetElapsedP' unless defined explicitely by an instance, + -- for efficiency reason, it's a good idea to override this methods if + -- you know the type is not more precise than Seconds. + timeGetNanoSeconds :: t -> NanoSeconds + timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t + +-- | Represent time types that can be created from other time types. +-- +-- Every conversion happens throught ElapsedP or Elapsed types. +class Timeable t => Time t where + -- | convert from a number of elapsed seconds and nanoseconds to another time representation + timeFromElapsedP :: ElapsedP -> t + + -- | convert from a number of elapsed seconds and nanoseconds to another time representation + -- + -- defaults to timeFromElapsedP unless defined explicitely by an instance. + timeFromElapsed :: Elapsed -> t + timeFromElapsed e = timeFromElapsedP (ElapsedP e 0) + +#if (MIN_VERSION_base(4,5,0)) +instance Timeable CTime where + timeGetElapsedP c = ElapsedP (timeGetElapsed c) 0 + timeGetElapsed (CTime c) = Elapsed (Seconds $ fromIntegral c) + timeGetNanoSeconds _ = 0 +instance Time CTime where + timeFromElapsedP (ElapsedP e _) = timeFromElapsed e + timeFromElapsed (Elapsed (Seconds c)) = CTime (fromIntegral c) +#endif + +instance Timeable Elapsed where + timeGetElapsedP e = ElapsedP e 0 + timeGetElapsed e = e + timeGetNanoSeconds _ = 0 +instance Time Elapsed where + timeFromElapsedP (ElapsedP e _) = e + timeFromElapsed e = e + +instance Timeable ElapsedP where + timeGetElapsedP e = e + timeGetNanoSeconds (ElapsedP _ ns) = ns +instance Time ElapsedP where + timeFromElapsedP e = e + +instance Timeable Date where + timeGetElapsedP d = timeGetElapsedP (DateTime d (TimeOfDay 0 0 0 0)) +instance Time Date where + timeFromElapsedP (ElapsedP elapsed _) = d + where (DateTime d _) = dateTimeFromUnixEpoch elapsed + +instance Timeable DateTime where + timeGetElapsedP d = ElapsedP (dateTimeToUnixEpoch d) (timeGetNanoSeconds d) + timeGetElapsed d = dateTimeToUnixEpoch d + timeGetNanoSeconds (DateTime _ (TimeOfDay _ _ _ ns)) = ns +instance Time DateTime where + timeFromElapsedP elapsed = dateTimeFromUnixEpochP elapsed + +-- | Convert one time representation into another one +-- +-- The return type need to be infer by the context. +-- +-- If the context cannot be infer through this, some specialized functions +-- are available for built-in types: +-- +-- * 'timeGetDate' +-- +-- * 'timeGetDateTimeOfDay' +-- +-- * 'timeGetElapsed', 'timeGetElapsedP' +timeConvert :: (Timeable t1, Time t2) => t1 -> t2 +timeConvert t1 = timeFromElapsedP (timeGetElapsedP t1) +{-# INLINE[2] timeConvert #-} +{-# RULES "timeConvert/ID" timeConvert = id #-} +{-# RULES "timeConvert/ElapsedP" timeConvert = timeGetElapsedP #-} +{-# RULES "timeConvert/Elapsed" timeConvert = timeGetElapsed #-} + +-- | Get the calendar Date (year-month-day) from a time representation +-- +-- specialization of 'timeConvert' +timeGetDate :: Timeable t => t -> Date +timeGetDate t = d where (DateTime d _) = timeGetDateTimeOfDay t +{-# INLINE[2] timeGetDate #-} +{-# RULES "timeGetDate/ID" timeGetDate = id #-} +{-# RULES "timeGetDate/DateTime" timeGetDate = dtDate #-} + +-- | Get the day time (hours:minutes:seconds) from a time representation +-- +-- specialization of 'timeConvert' +timeGetTimeOfDay :: Timeable t => t -> TimeOfDay +timeGetTimeOfDay t = tod where (DateTime _ tod) = timeGetDateTimeOfDay t +{-# INLINE[2] timeGetTimeOfDay #-} +{-# RULES "timeGetTimeOfDay/Date" timeGetTimeOfDay = const (TimeOfDay 0 0 0 0) #-} +{-# RULES "timeGetTimeOfDay/DateTime" timeGetTimeOfDay = dtTime #-} + +-- | Get the date and time of day from a time representation +-- +-- specialization of 'timeConvert' +timeGetDateTimeOfDay :: Timeable t => t -> DateTime +timeGetDateTimeOfDay t = dateTimeFromUnixEpochP $ timeGetElapsedP t +{-# INLINE[2] timeGetDateTimeOfDay #-} +{-# RULES "timeGetDateTimeOfDay/ID" timeGetDateTimeOfDay = id #-} +{-# RULES "timeGetDateTimeOfDay/Date" timeGetDateTimeOfDay = flip DateTime (TimeOfDay 0 0 0 0) #-} + +-- | add some time interval to a time representation and returns this new time representation +-- +-- example: +-- +-- > t1 `timeAdd` mempty { durationHours = 12 } +timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t +timeAdd t ti = timeFromElapsedP $ elapsedTimeAddSecondsP (timeGetElapsedP t) (toSeconds ti) + +-- | Get the difference in seconds between two time representation +-- +-- effectively: +-- +-- > t2 `timeDiff` t1 = t2 - t1 +timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds +timeDiff t1 t2 = sec where (Elapsed sec) = timeGetElapsed t1 - timeGetElapsed t2 + +-- | Get the difference in seconds and nanoseconds between two time representation +-- +-- effectively: +-- +-- > @t2 `timeDiffP` t1 = t2 - t1 +timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds) +timeDiffP t1 t2 = (sec, ns) + where (ElapsedP (Elapsed sec) ns) = timeGetElapsedP t1 - timeGetElapsedP t2
+ Data/Hourglass/Types.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Data.Hourglass.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- +-- Basic times units and types. +-- +-- While pratically some units could hold infinite values, for practical +-- and efficient purpose they are limited to int64 types for seconds +-- and int types for years. +-- +-- Most units use the unix epoch referential, but by no means reduce portability. +-- the unix referential works under the Windows platform or any other platforms. +-- +-- This module will be depreciated in favor of Time.Types +-- +module Data.Hourglass.Types + ( module Time.Types + ) where + +import Time.Types
+ Data/Hourglass/Utils.hs view
@@ -0,0 +1,33 @@+-- | +-- Module : Data.Hourglass.Utils +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- some padding / formatting functions +-- +module Data.Hourglass.Utils where + +-- | pad a number to 2 digits +pad2 :: (Show a, Ord a, Num a, Integral a) => a -> String +pad2 v | v >= 100 = pad2 (v `mod` 100) + | v >= 10 = show v + | otherwise = '0' : show v + +-- | pad a number to 4 digits +pad4 :: (Show a, Ord a, Num a, Integral a) => a -> String +pad4 v | v >= 1000 = show v + | v >= 100 = '0' : show v + | v >= 10 = '0':'0' : show v + | otherwise = '0':'0':'0': show v + +-- | Pad a number to at least N digits. +-- +-- if the number is greater, no truncation happens. +padN :: (Show a, Ord a, Num a, Integral a) => Int -> a -> String +padN n v + | vlen >= n = vs + | otherwise = replicate (n - vlen) '0' ++ vs + where vs = show v + vlen = length vs
+ Data/Hourglass/Zone.hs view
@@ -0,0 +1,52 @@+-- | +-- Module : Data.Hourglass.Zone +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Timezone utility +-- +{-# LANGUAGE ExistentialQuantification #-} +module Data.Hourglass.Zone + ( Timezone(..) + , UTC(..) + , TimezoneMinutes(..) + ) where + +-- | standard representation for timezone +class Timezone tz where + -- | offset in minutes from UTC. valid values should be between -12*60 to +14*60 + timezoneOffset :: tz -> Int + -- | the name of the timezone. by default will be +-HH:MM encoding. + timezoneName :: tz -> String + timezoneName = tzMinutesPrint . timezoneOffset + +-- | Simple timezone containing the number of minutes difference +-- with UTC. +-- +-- Valid values should be between -12*60 to +14*60 +newtype TimezoneMinutes = TimezoneMinutes Int + deriving (Show,Eq,Ord) + +-- | Universal Time Coordinated. The generic computer "timezone". +data UTC = UTC + deriving (Show,Eq,Ord) + +instance Timezone UTC where + timezoneOffset _ = 0 + timezoneName _ = "UTC" + +instance Timezone TimezoneMinutes where + timezoneOffset (TimezoneMinutes minutes) = minutes + +-- | print a minute offset in format: +-- (+-)HH:MM +tzMinutesPrint :: Int -> String +tzMinutesPrint offset = + (if offset > 0 then '+' else '-') + : (pad0 h ++ ":" ++ pad0 m) + where (h,m) = abs offset `divMod` 60 + pad0 v + | v < 10 = '0':show v + | otherwise = show v
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2014 Vincent Hanquez <vincent@snarc.org> + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,96 @@+time-hourglass +============== + + +[](https://opensource.org/licenses/BSD-3-Clause) +[](http://haskell.org) + +Originally forked from +[`hourglass-0.2.12`](https://hackage.haskell.org/package/hourglass-0.2.12). + +Hourglass is a simple time library. + +Documentation: [time-hourglass on hackage](http://hackage.haskell.org/package/time-hourglass) + +Design +------ +Key parts of the design are the Timeable and Time typeclasses. +Time representations of the same time values are interchangeable and easy to convert +between each other. This also allows the user to define new time types that +interact with the same functions as the built-in types. + +For example: +```haskell +let dateTime0 = + DateTime { dtDate = Date { dateYear = 1970, dateMonth = January, dateDay = 1 } + , dtTime = TimeOfDay {todHour = 0, todMin = 0, todSec = 0, todNSec = 0 }} + elapsed0 = Elasped 0 + +> timeGetElapsed elapsed0 == timeGetElapsed dateTime0 +True +> timeGetDate elapsed0 == timeGetDate dateTime0 +True +> timePrint "YYYY-MM" elapsed0 +"1970-01" +> timePrint "YYYY-MM" dateTime0 +"1970-01" +``` + +Hourglass has the same limitations as your system: + +* On 32 bit linux, you can't get a date after the year 2038. +* In Windows 7, you can't get the date before the year 1601. + +Comparaison with time +--------------------- +* Getting posix time: +```haskell +-- With time +import Data.Time.Clock.POSIX + +ptime <- getPOSIXTime + +-- With hourglass +import System.Hourglass + +ptime <- timeCurrent +``` + +* Getting the current year: +```haskell +-- With time +import Data.Time.Clock +import Data.Time.Calendar + +currentYear <- (\(y,_,_) -> y) . toGregorian . utcDay <$> getCurrentTime + +-- With hourglass +import System.Hourglass +import Data.Time + +currentYear <- dateYear . timeGetDate <$> timeCurrent +``` + +* Representating "4th May 1970 15:12:24" +```haskell +-- With time +import Data.Time.Clock +import Date.Time.Calendar + +let day = fromGregorian 1970 5 4 + diffTime = secondsToDiffTime (15 * 3600 + 12 * 60 + 24) +in UTCTime day diffTime + +-- With hourglass +import Date.Time + +DateTime (Date 1970 May 4) (TimeOfDay 15 12 24 0) +``` + +History +------- + +The [`hourglass`](https://hackage.haskell.org/package/hourglass) package was +originated and then maintained by Vincent Hanquez. For published reasons, he +does not intend to develop the package further after version 0.2.12 but he also +does not want to introduce other maintainers.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ System/Hourglass.hs view
@@ -0,0 +1,16 @@+-- | +-- Module : System.Hourglass +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Get the system timezone and current time value in multiple formats +-- +-- This module will be depreciated in favor of Time.System +-- +module System.Hourglass + ( module Time.System + ) where + +import Time.System
+ Time/Compat.hs view
@@ -0,0 +1,104 @@+-- | +-- Module : Time.Compat +-- License : BSD-style +-- Maintainer : Nicolas DI PRIMA <nicolas@di-prima.fr> +-- +-- Basic Time conversion compatibility. +-- +-- This module aims to help conversion between the types from the package +-- time to the package hourglass. +-- +-- Example of use (extracted from file Example/Time/Compat.hs): +-- +-- > import Data.Hourglass as H +-- > import Data.Hourglass.Compat as C +-- > import Data.Time as T +-- > +-- > transpose :: T.ZonedTime +-- > -> H.LocalTime H.DateTime +-- > transpose oldTime = +-- > H.localTime +-- > offsetTime +-- > (H.DateTime newDate timeofday) +-- > where +-- > newDate :: H.Date +-- > newDate = C.dateFromTAIEpoch $ T.toModifiedJulianDay $ T.localDay $ T.zonedTimeToLocalTime oldTime +-- > +-- > timeofday :: H.TimeOfDay +-- > timeofday = C.diffTimeToTimeOfDay $ T.timeOfDayToTime $ T.localTimeOfDay $ T.zonedTimeToLocalTime oldTime +-- > +-- > offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime +-- +module Time.Compat + ( dateFromPOSIXEpoch + , dateFromTAIEpoch + , diffTimeToTimeOfDay + ) where + +import Data.Hourglass + +-- | Convert an integer which represent the Number of days (To/From) POSIX Epoch +-- to a Date (POSIX Epoch is 1970-01-01). +dateFromPOSIXEpoch :: Integer -- ^ number of days since POSIX Epoch + -> Date +dateFromPOSIXEpoch day = do + let sec = Elapsed $ fromIntegral $ day * 86400 + timeConvert sec + +-- | Number of days between POSIX Epoch and TAI Epoch +-- (between 1858-11-17 and 1970-01-01) +daysTAItoPOSIX :: Integer +daysTAItoPOSIX = 40587 + +-- | Convert an integer which represents the Number of days (To/From) TAI Epoch +-- This function allows use of the package time to easily convert the Day into +-- the Hourglass Date representation (TAI Epoch is 1858-11-17). +-- +-- This function allows user to easily convert a Data.Time.Calendar.Day into Date +-- +-- > import qualified Data.Time.Calendar as T +-- > +-- > timeDay :: T.Day +-- > +-- > dateFromTAIEpoch $ T.toModifiedJulianDay timeDay +dateFromTAIEpoch :: Integer -- ^ number of days since TAI Epoch + -> Date +dateFromTAIEpoch dtai = + dateFromPOSIXEpoch (dtai - daysTAItoPOSIX) + +-- | Convert of differential of time of a day. +-- (it convers a Data.Time.Clock.DiffTime into a TimeOfDay) +-- +-- Example with DiffTime type from time: +-- +-- > import qualified Data.Time.Clock as T +-- > +-- > difftime :: T.DiffTime +-- > +-- > diffTimeToTimeOfDay difftime +-- +-- Example with the TimeOfDay type from time: +-- +-- > import qualified Data.Time.Clock as T +-- > +-- > timeofday :: T.TimeOfDay +-- > +-- > diffTimeToTimeOfDay $ T.timeOfDayToTime timeofday +diffTimeToTimeOfDay :: Real t + => t -- ^ number of seconds of the time of the day + -> TimeOfDay +diffTimeToTimeOfDay dt = do + TimeOfDay + { todHour = fromIntegral hours + , todMin = fromIntegral minutes + , todSec = fromIntegral seconds + , todNSec = fromIntegral nsecs + } + where + r :: Rational + r = toRational dt + (secs, nR) = properFraction r :: (Integer, Rational) + nsecs :: Integer + nsecs = round (nR * 1000000000) + (minsofday, seconds) = secs `divMod` 60 :: (Integer, Integer) + (hours, minutes) = minsofday `divMod` 60 :: (Integer, Integer)
+ Time/System.hs view
@@ -0,0 +1,58 @@+-- | +-- Module : Time.System +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- Stability : experimental +-- Portability : unknown +-- +-- Get the system timezone and current time value in multiple formats +-- +module Time.System + ( + -- * Current time in computer friendly format + timeCurrent + , timeCurrentP + -- * Current time in human friendly DateTime format + , dateCurrent + , localDateCurrent + , localDateCurrentAt + -- * System timezone + , timezoneCurrent + ) where + +import Control.Applicative +import Time.Types +import Data.Hourglass.Time +import Data.Hourglass.Local +import Data.Hourglass.Internal (systemGetElapsedP, systemGetElapsed, systemGetTimezone) + +-- | Get the current elapsed seconds since epoch +timeCurrent :: IO Elapsed +timeCurrent = systemGetElapsed + +-- | Get the current elapsed seconds (precise to the nanosecond) since epoch +timeCurrentP :: IO ElapsedP +timeCurrentP = systemGetElapsedP + +-- | 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 = localTimeSetTimezone <$> timezoneCurrent + <*> (localTimeFromGlobal <$> dateCurrent) + +-- | Get the localized date at a specific timezone offset. +localDateCurrentAt :: TimezoneOffset -> IO (LocalTime DateTime) +localDateCurrentAt tz = localTimeSetTimezone tz . localTimeFromGlobal <$> dateCurrent + +-- | Get the current timezone offset +-- +-- This include daylight saving time when in operation. +timezoneCurrent :: IO TimezoneOffset +timezoneCurrent = systemGetTimezone
+ Time/Types.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Time.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez <vincent@snarc.org> +-- +-- Basic times units and types. +-- +-- While pratically some units could hold infinite values, for practical +-- and efficient purpose they are limited to int64 types for seconds +-- and int types for years. +-- +-- Most units use the unix epoch referential, but by no means reduce portability. +-- the unix referential works under the Windows platform or any other platforms. +-- +module Time.Types + ( + -- * Time units + NanoSeconds(..) + , Seconds(..) + , Minutes(..) + , Hours(..) + , TimeInterval(..) + -- * Time enumeration + , Month(..) + , WeekDay(..) + -- * Timezone + , TimezoneOffset(..) + , timezoneOffsetToSeconds + , timezone_UTC + -- * Computer friendly format + -- ** Unix elapsed + , Elapsed(..) + , ElapsedP(..) + -- * Human friendly format + -- ** Calendar time + , Date(..) + , TimeOfDay(..) + , DateTime(..) + ) where + +import Data.Int +import Data.Data +import Data.Ratio +import Control.DeepSeq +import Data.Hourglass.Utils (pad2) + +-- | Represent any time interval that has an +-- equivalent value to a number of seconds. +class TimeInterval i where + toSeconds :: i -> Seconds + fromSeconds :: Seconds -> (i, Seconds) + +-- | Nanoseconds +newtype NanoSeconds = NanoSeconds Int64 + deriving (Read,Eq,Ord,Num,Data,Typeable,NFData) + +instance Show NanoSeconds where + show (NanoSeconds v) = shows v "ns" + +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. +-- +-- However, because of limitation in the calendar conversion +-- 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,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) + +instance Show Elapsed where + show (Elapsed s) = show s + +-- | A number of seconds and nanoseconds elapsed since the unix epoch. +data ElapsedP = ElapsedP {-# UNPACK #-} !Elapsed {-# UNPACK #-} !NanoSeconds + deriving (Read,Eq,Ord,Data,Typeable) + +instance Show ElapsedP where + show (ElapsedP e ns) = shows e ('.' : show ns) + +instance NFData ElapsedP where rnf e = e `seq` () + +instance Num ElapsedP where + (+) = addElapsedP + (-) = subElapsedP + (ElapsedP e1 ns1) * (ElapsedP e2 ns2) = ElapsedP (e1*e2) (ns1*ns2) + negate (ElapsedP e ns) = ElapsedP (negate e) ns + abs (ElapsedP e ns) = ElapsedP (abs e) ns + signum (ElapsedP e ns) = ElapsedP (signum e) ns + fromInteger i = ElapsedP (Elapsed (fromIntegral i)) 0 + +addElapsedP :: ElapsedP -> ElapsedP -> ElapsedP +addElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) = + let notNormalizedNS = ns1 + ns2 + (retainedNS, ns) = notNormalizedNS `divMod` 1000000000 + in ElapsedP (e1 + e2 + (Elapsed $ Seconds retainedNS)) (NanoSeconds ns) + +subElapsedP :: ElapsedP -> ElapsedP -> ElapsedP +subElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) = + let notNormalizedNS = ns1 - ns2 + notNormalizedS = e1 - e2 + in if notNormalizedNS < 0 + then ElapsedP (notNormalizedS - oneSecond) (NanoSeconds (1000000000 + notNormalizedNS)) + else ElapsedP notNormalizedS (NanoSeconds notNormalizedNS) + where + oneSecond :: Elapsed + oneSecond = Elapsed $ Seconds 1 + +instance Real ElapsedP where + toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds 0)) = + fromIntegral s + toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds ns)) = + fromIntegral s + (fromIntegral ns % 1000000000) + +-- | Month of the year +data Month = + January + | February + | March + | April + | May + | June + | July + | August + | September + | October + | November + | December + deriving (Show,Read,Eq,Ord,Enum,Data,Typeable,Bounded) + +-- | Day of the week +-- +-- the enumeration starts on Sunday. +data WeekDay = + Sunday + | Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + deriving (Show,Read,Eq,Ord,Enum,Data,Typeable,Bounded) + +-- | Offset against UTC in minutes to obtain from UTC time, local time. +-- +-- * a positive number represent a location East of UTC. +-- +-- * a negative number represent a location West of UTC. +-- +-- 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 +-- +-- Example: +-- in AUSEDT (UTC+1000 with daylight = UTC+1100), local time is 15:47; +-- Thus, UTC time is 04:47, and TimezoneOffset is +660 (minutes) +-- +newtype TimezoneOffset = TimezoneOffset + { timezoneOffsetToMinutes :: Int -- ^ return the number of minutes + } deriving (Eq,Ord,Data,Typeable,NFData) + +-- | Return the number of seconds associated with a timezone +timezoneOffsetToSeconds :: TimezoneOffset -> Seconds +timezoneOffsetToSeconds (TimezoneOffset ofs) = Seconds (fromIntegral ofs * 60) + +instance Show TimezoneOffset where + show (TimezoneOffset tz) = + 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 + , dateDay :: {-# UNPACK #-} !Int -- ^ day of the month, between 1 to 31 + } deriving (Show,Read,Eq,Ord,Data,Typeable) + +instance NFData Date where + rnf (Date y m d) = y `seq` m `seq` d `seq` () + +-- | human time representation of hour, minutes, seconds in a day. +data TimeOfDay = TimeOfDay + { 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,Read,Eq,Ord,Data,Typeable) + +instance NFData TimeOfDay where + rnf (TimeOfDay h m s ns) = h `seq` m `seq` s `seq` ns `seq` () + +-- | Date and Time +data DateTime = DateTime + { dtDate :: Date + , dtTime :: TimeOfDay + } deriving (Show,Read,Eq,Ord,Data,Typeable) + +instance NFData DateTime where + rnf (DateTime d t) = rnf d `seq` rnf t `seq` ()
+ cbits/unix.c view
@@ -0,0 +1,31 @@+/* + * lowlevel binder for macosx and + */ +#include <time.h> +#if defined __MACH__ && !defined __GNU__ +#include <mach/clock.h> +#include <mach/mach.h> +#endif + +/* on mac os X, clock_gettime doesn't exists, but + * http://stackoverflow.com/questions/5167269/clock-gettime-alternative-in-mac-os-x + * + * we ignore errors as it's very very unlikely considering the hardcoded ID + * and the fact that haskell should call this code. + */ +void hourglass_clock_calendar(struct timespec *timespec) +{ +#if defined __MACH__ && !defined __GNU__ + clock_serv_t cclock; + mach_timespec_t mts; + + host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock); + clock_get_time(cclock, &mts); + mach_port_deallocate(mach_task_self(), cclock); + + timespec->tv_sec = mts.tv_sec; + timespec->tv_nsec = mts.tv_nsec; +#else + clock_gettime(CLOCK_REALTIME, timespec); +#endif +}
+ tests/Bench.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE BangPatterns #-} +module Main (main) where + +import Gauge.Main +import Data.Hourglass +import System.Hourglass +import TimeDB + +import Data.List (intercalate) +import qualified Data.Time.Calendar as T +import qualified Data.Time.Clock as T +import qualified Data.Time.Clock.POSIX as T +import qualified System.Locale as T + +timeToTuple :: T.UTCTime -> (Int, Int, Int, Int, Int, Int) +timeToTuple utcTime = (fromIntegral y, m, d, h, mi, sec) + where (!y,!m,!d) = T.toGregorian (T.utctDay utcTime) + !daytime = floor $ T.utctDayTime utcTime + (!dt, !sec) = daytime `divMod` 60 + (!h , !mi) = dt `divMod` 60 + +timeToTupleDate :: T.UTCTime -> (Int, Int, Int) +timeToTupleDate utcTime = (fromIntegral y, m, d) + where (!y,!m,!d) = T.toGregorian (T.utctDay utcTime) + +elapsedToPosixTime :: Elapsed -> T.POSIXTime +elapsedToPosixTime (Elapsed (Seconds s)) = fromIntegral s + +timePosixDict :: [ (Elapsed, T.POSIXTime) ] +timePosixDict = + [-- (Elapsed 0, 0) + --, (Elapsed 1000000, 1000000) + --, (Elapsed 9000099, 9000099) + {-,-} (Elapsed 1398232846, 1398232846) -- currentish time (at the time of writing) + --, (Elapsed 5134000099, 5134000099) + --, (Elapsed 10000000000000, 10000000000000) -- year 318857 .. + ] + +dateDict :: [ (Int, Int, Int, Int, Int, Int) ] +dateDict = + [{- (1970, 1, 1, 1, 1, 1) + , -}(2014, 5, 5, 5, 5, 5) + --, (2114, 11, 5, 5, 5, 5) + ] + +main :: IO () +main = defaultMain + [ bgroup "highlevel" $ concatMap toHighLevel timePosixDict + , bgroup "to-dateTime" $ concatMap toCalendar timePosixDict + , bgroup "to-date" $ concatMap toCalendarDate timePosixDict + , bgroup "utc-to-date" $ concatMap toCalendarUTC timePosixDict + , bgroup "to-posix" $ concatMap toPosix dateDict + , bgroup "system" fromSystem + ] + where toHighLevel (posixHourglass, posixTime) = + [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass + , bench (showT posixTime) $ nf T.posixSecondsToUTCTime posixTime + ] + toCalendar (posixHourglass, posixTime) = + [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass + , bench (showT posixTime) $ nf (timeToTuple . T.posixSecondsToUTCTime) posixTime + ] + toCalendarDate (posixHourglass, posixTime) = + [ bench (showH posixHourglass) $ nf timeGetDate posixHourglass + , bench (showT posixTime) $ nf (timeToTupleDate . T.posixSecondsToUTCTime) posixTime + ] + toCalendarUTC (posixHourglass, posixTime) = + [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass + , bench (showT utcTime) $ nf timeToTuple utcTime + ] + where !utcTime = T.posixSecondsToUTCTime posixTime + toPosix v = + [ bench ("hourglass/" ++ n v) $ nf hourglass v + , bench ("time/" ++ n v) $ nf time v + ] + where n (y,m,d,h,mi,s) = (intercalate "-" $ map show [y,m,d]) ++ " " ++ (intercalate ":" $ map show [h,mi,s]) + hourglass (y,m,d,h,mi,s) = timeGetElapsed $ DateTime (Date y (toEnum (m-1)) d) (TimeOfDay (fromIntegral h) (fromIntegral mi) (fromIntegral s) 0) + time (y,m,d,h,mi,s) = let day = T.fromGregorian (fromIntegral y) m d + diffTime = T.secondsToDiffTime $ fromIntegral (h * 3600 + mi * 60 + s) + in T.utcTimeToPOSIXSeconds (T.UTCTime day diffTime) + + fromSystem = + [ bench ("hourglass/p") $ nfIO timeCurrent + , bench ("hourglass/ns") $ nfIO timeCurrentP + , bench ("time/posixTime") $ nfIO T.getPOSIXTime + , bench ("time/utcTime") $ nfIO T.getCurrentTime + ] + + showH :: Show a => a -> String + showH a = "hourglass/" ++ show a + showT :: Show a => a -> String + showT a = "time/" ++ show a
+ tests/Tests.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +module Main where + +import Control.Applicative + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +import Data.Ratio +import Data.Word +import Data.Int +import Data.Hourglass +import Data.Hourglass.Epoch + +import Foreign.Storable +import Foreign.C.Types (CTime) + +import qualified Data.Time.Calendar as T +import qualified Data.Time.Clock as T +import qualified Data.Time.Clock.POSIX as T +import qualified Data.Time.Format as T +#if MIN_VERSION_time(1,5,0) +import qualified System.Locale as T hiding (defaultTimeLocale) +#else +import qualified System.Locale as T +#endif + +import qualified Control.Exception as E + +import TimeDB + +tmPosix0 :: Elapsed +tmPosix0 = fromIntegral (0 :: Word64) + +timePosix0 :: T.POSIXTime +timePosix0 = fromIntegral (0 :: Word64) + +elapsedToPosixTime :: Elapsed -> T.POSIXTime +elapsedToPosixTime (Elapsed (Seconds s)) = fromIntegral s + +dateEqual :: LocalTime DateTime -> T.UTCTime -> Bool +dateEqual localtime utcTime = + and [ fromIntegral y == y', m' == (fromEnum m + 1), d' == d + , 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 + (h' , mi') = dt' `divMod` 60 + (DateTime (Date y m d) (TimeOfDay h mi sec _)) = localTimeToGlobal localtime + +-- | The @Date@ type is able to represent some values that aren't actually legal, +-- specifically dates with a day field outside of the range of dates in the +-- month. This function validates a @Date@. +isValidDate :: Date -> Bool +isValidDate (Date y m d) = d > 0 && d <= (daysInMonth y m) + +-- windows native functions to convert time cannot handle time before year 1601 +#ifdef WINDOWS +loElapsed = -11644473600 -- ~ year 1601 +hiElapsed = 32503680000 +dateRange = (1800, 2202) +#else +isCTime64 = sizeOf (undefined :: CTime) == 8 +loElapsed = + if isCTime64 + then -62135596800 -- ~ year 0 + else -(2^(28 :: Int)) +hiElapsed = + if isCTime64 + then 2^(55 :: Int) -- in a future far far away + else 2^(29 :: Int) -- before the 2038 bug. +dateRange = + if isCTime64 + then (1800, 2202) + else (1960, 2036) +#endif +instance Arbitrary Seconds where + arbitrary = Seconds . toHiLo <$> arbitrary + where toHiLo v | v > loElapsed && v < hiElapsed = v + | 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 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 + arbitrary = DateTime <$> arbitrary <*> arbitrary +instance Arbitrary Date where + arbitrary = do + year <- choose dateRange + month <- arbitrary + Date year month <$> choose (1, daysInMonth year month) +instance Arbitrary TimeOfDay where + 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 + +eq expected got + | expected == got = True + | otherwise = error ("expected: " ++ show expected ++ " got: " ++ show got) + +testCaseWith :: (Num a, Eq a, Show a) => String -> (a -> a -> a) -> (a, a, a) -> TestTree +testCaseWith what fun (x, y, ref) = + testCase ((show x) ++ " " ++ what ++ " " ++ (show y) ++ " ?= " ++ (show ref)) checkAdd + where + checkAdd :: Assertion + checkAdd = + if fun x y /= ref + then assertFailure $ (show $ fun x y) ++ " /= " ++ (show ref) + else return () + +arithmeticTestAddRef :: [(ElapsedP, ElapsedP, ElapsedP)] +arithmeticTestAddRef = map testRefToElapsedP + [ ((1, 090000000), (2, 090000000), (3, 180000000)) + , ((1, 900000000), (1, 200000000), (3, 100000000)) + , ((1, 000000001), (0, 999999999), (2, 000000000)) + ] + +arithmeticTestSubRef :: [(ElapsedP, ElapsedP, ElapsedP)] +arithmeticTestSubRef = map testRefToElapsedP + [ ((1, ms 100), (1, ms 100), (0, ms 000)) + , ((1, ms 900), (1, ms 100), (0, ms 800)) + , ((1, ms 100), (0, ms 200), (0, ms 900)) + , ((1, ms 100), (2, ms 400), (-2, ms 700)) + ] + where ms v = v * 1000000 + +testRefToElapsedP :: ((Int64, Int64), (Int64, Int64), (Int64, Int64)) -> (ElapsedP, ElapsedP, ElapsedP) +testRefToElapsedP (a, b, c) = (tupleToElapsedP a, tupleToElapsedP b, tupleToElapsedP c) + where + tupleToElapsedP :: (Int64, Int64) -> ElapsedP + tupleToElapsedP (s, n) = ElapsedP (Elapsed $ Seconds s) (NanoSeconds n) + +tests knowns = testGroup "hourglass" + [ testGroup "known" + [ 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) -> + e `eq` timeGetElapsed (timeGetDateTimeOfDay e) + , testProperty "win epoch" $ \(e :: Elapsed) -> + let e2 = timeConvert e :: ElapsedSince WindowsEpoch + in timePrint ISO8601_DateAndTime e `eq` timePrint ISO8601_DateAndTime e2 + ] + , testGroup "localtime" + [ testProperty "eq" $ \(l :: LocalTime Elapsed) -> + let g = localTimeToGlobal l + 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" + [ testGroup "ElapseP add" $ map (testCaseWith "+" (+)) arithmeticTestAddRef + , testGroup "ElapseP sub" $ map (testCaseWith "-" (-)) arithmeticTestSubRef + {-testProperty "add-diff" $ \(e :: Elapsed, tdiff) -> + let d@(TimeDiff _ _ day h mi s _) = tdiff { timeDiffYears = 0 + , timeDiffMonths = 0 + , timeDiffNs = 0 + } + i64 = fromIntegral + accSecs = (((i64 day * 24) + i64 h) * 60 + i64 mi) * 60 + i64 s :: Int64 + e' = timeAdd e d + in Seconds accSecs `eq` timeDiff e' e + , testProperty "calendar-add-month" $ \date@(DateTime (Date y m d) _) -> + let date'@(DateTime (Date y' m' d') _) = timeAdd date (mempty { timeDiffMonths = 1 }) + in timeGetTimeOfDay date `eq` timeGetTimeOfDay date' && + (d `eq` d') && + (toEnum ((fromEnum m+1) `mod` 12) `eq` m') && + (if m == December then (y+1) `eq` y' else y `eq` y') + -} + + -- Make sure our Arbitrary instance only generates valid dates: + , testProperty "Arbitrary-isValidDate" isValidDate + + , testProperty "dateAddPeriod" $ (\date period -> + isValidDate (date `dateAddPeriod` period)) + ] + , testGroup "formating" + [ testProperty "iso8601 date" $ \(e :: Elapsed) -> + (calTimeFormatTimeISO8601 (elapsedToPosixTime e) `eq` timePrint ISO8601_Date e) + , testProperty "unix seconds" $ \(e :: Elapsed) -> + let sTime = T.formatTime T.defaultTimeLocale "%s" (T.posixSecondsToUTCTime $ elapsedToPosixTime e) + sHg = timePrint "EPOCH" e + in sTime `eq` sHg + ] + , testGroup "parsing" + [ testProperty "iso8601 date" $ \(e :: Elapsed) -> + let fmt = calTimeFormatTimeISO8601 (elapsedToPosixTime e) + ed1 = localTimeParseE ISO8601_Date fmt + md2 = T.parseTimeM True T.defaultTimeLocale fmt "%F" + in case (ed1,md2) of + (Left err, Nothing) -> error ("both cannot parse: " ++ show fmt ++ " hourglass-err=" ++ show err) + (Left err, Just _) -> error ("error parsing string: " ++ show err) + (Right (d1, ""), Just d2) -> dateEqual d1 d2 + (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 = localTimeParseE "TZHM" (show tz) in + case r of + Right (localtime, "") -> tz `eq` localTimeGetTimezone localtime + _ -> error "Cannot parse timezone" + , testProperty "custom-1" $ test_property_format ("YYYY-MM-DDTH:MI:S.msusns" :: String) + , testProperty "custom-2" $ test_property_format ("Mon DD\\t\\h YYYY at HH\\hMI\\mS\\s.p9\\n\\s" :: String) + ] + , testGroup "Regression Tests" + [ testCase "Real instance of ElapsedP (#33)" $ + let res = toRational (ElapsedP (Elapsed $ Seconds 0) (NanoSeconds 0)) + ref = toRational 0 :: Rational + in assertEqual "failed equality" ref res + , testCase "Real instance of ElapsedP (#33) (2)" $ + let res = toRational (ElapsedP (Elapsed $ Seconds 100) (NanoSeconds 1000000)) + ref = toRational 100 + (1 % 1000) :: Rational + in assertEqual "failed equality" ref res + ] + ] + where toCalendarTest (i, (us, dt)) = + testCase (show i) (dt @=? timeGetDateTimeOfDay us) + toSecondTest (i, (us@(Elapsed (Seconds s)), dt)) = + testCase (show i ++ "-" ++ show s ++ "s") (us @=? timeGetElapsed dt) + 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) + + calTimeFormatTimeISO8601 timePosix = + T.formatTime T.defaultTimeLocale "%F" (T.posixSecondsToUTCTime timePosix) + + test_property_format :: (TimeFormat format, Show format) => format -> DateTime -> Bool + test_property_format fmt dt = + let p1 = timePrint fmt dt in + case timeParseE fmt p1 of + Left (fmtEl, err) -> error ("cannot decode printed DateTime: " ++ show p1 ++ " with format " ++ show fmt ++ " error with(" ++ show fmtEl ++ "): " ++ err) + Right (dt2, _) -> dt `eq` dt2 + +main = do + knowns <- E.catch (map parseTimeConv . lines <$> readFile "test-time-db") + (\(_ :: E.SomeException) -> return []) + defaultMain (tests knowns)
+ tests/TimeDB.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE BangPatterns #-} +module TimeDB (parseTimeConv) where + +import Data.Char (isDigit) +import Data.Int +import Data.Hourglass + +r :: (Read a, Num a) => String -> a +r !s + | isNumber s = case reads s of + [(n,"")] -> fromIntegral (n :: Int64) + [] -> error ("cannot parse anything: " ++ show s) + _ -> error ("cannot parse anything: " ++ show s) + | otherwise = error ("not a num: " ++ s) + where + isNumber [] = False + isNumber ('-':xs) = allNum xs + isNumber n@(_:_) = allNum n + + allNum = and . map isDigit + +wordsWhen :: (Char -> Bool) -> String -> [String] +wordsWhen p s = case dropWhile p s of + "" -> [] + s' -> w : wordsWhen p s'' + where (w, s'') = break p s' + +parseTimeConv :: String -> (Elapsed, DateTime, WeekDay, Int) +parseTimeConv v = + case wordsWhen (== ':') v of + ts:y:m:d:h:n:s:wd:doy:[] -> + ( r ts + , DateTime (Date (r y) (toEnum $ r m - 1) (r d)) (TimeOfDay (r h) (r n) (r s) 0) + , read wd + , r doy) + l -> error ("invalid line: " ++ show l)
+ time-hourglass.cabal view
@@ -0,0 +1,110 @@+cabal-version: 1.12 ++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name: time-hourglass+version: 0.2.12+synopsis: simple performant time related library+description: Simple time library focusing on simple but powerful and performant API+ .+ The backbone of the library are the Timeable and Time type classes.+ .+ Each Timeable instances can be converted to type that has a Time instances,+ and thus are different representations of current time.+category: Time+stability: experimental+homepage: https://github.com/mpilgrem/time-hourglass+bug-reports: https://github.com/mpilgrem/time-hourglass/issues+author: Vincent Hanquez <vincent@snarc.org>+maintainer: Mike Pilgrem <public@pilgrem.com>+copyright: Vincent Hanquez <vincent@snarc.org>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ CHANGELOG.md+ README.md+ tests/TimeDB.hs++source-repository head+ type: git+ location: https://github.com/mpilgrem/time-hourglass++library+ exposed-modules:+ Time.Types+ Time.System+ Time.Compat+ Data.Hourglass+ Data.Hourglass.Types+ Data.Hourglass.Epoch+ Data.Hourglass.Compat+ System.Hourglass+ other-modules:+ Data.Hourglass.Time+ Data.Hourglass.Format+ Data.Hourglass.Diff+ Data.Hourglass.Local+ Data.Hourglass.Calendar+ Data.Hourglass.Zone+ Data.Hourglass.Internal+ Data.Hourglass.Utils+ ghc-options: -Wall -fwarn-tabs+ build-depends:+ base ==4.*+ , deepseq+ default-language: Haskell2010+ if os(windows)+ other-modules:+ Data.Hourglass.Internal.Win+ cpp-options: -DWINDOWS+ build-depends:+ Win32+ else+ other-modules:+ Data.Hourglass.Internal.Unix+ c-sources:+ cbits/unix.c++test-suite test-hourglass+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ other-modules:+ TimeDB+ hs-source-dirs:+ tests+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ build-depends:+ base >=3 && <5+ , deepseq+ , hourglass+ , mtl+ , old-locale+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , time+ default-language: Haskell2010+ if os(windows)+ cpp-options: -DWINDOWS++benchmark bench-hourglass+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ other-modules:+ Tests+ TimeDB+ hs-source-dirs:+ tests+ build-depends:+ base ==4.*+ , bytestring+ , deepseq+ , gauge+ , hourglass+ , mtl+ , old-locale+ , time+ default-language: Haskell2010