packages feed

hourglass (empty) → 0.1.0

raw patch · 21 files changed

+2018/−0 lines, 21 filesdep +HUnitdep +QuickCheckdep +Win32setup-changed

Dependencies added: HUnit, QuickCheck, Win32, base, bytestring, criterion, deepseq, hourglass, mtl, old-locale, test-framework, test-framework-hunit, test-framework-quickcheck2, time

Files

+ Data/Hourglass.hs view
@@ -0,0 +1,40 @@+-- |+-- 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+    ) 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)
+ Data/Hourglass/Calendar.hs view
@@ -0,0 +1,88 @@+-- |+-- 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+    , 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++-- | 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 _) =+    fromIntegral h * 3600 + fromIntegral m * 60 + fromIntegral 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/Diff.hs view
@@ -0,0 +1,151 @@+-- |+-- Module      : Data.Hourglass.Diff+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- time arithmetic methods+--+module Data.Hourglass.Diff+    ( TimeDiff(..)+    , normalizeTimeDiff+    , dateTimeAdd+    , elapsedTimeAddSeconds+    , elapsedTimeAddSecondsP+    , elapsedTimeAdd+    , elapsedTimeAddP+    ) where++import Data.Int+import Data.Monoid+import Data.Hourglass.Types+import Data.Hourglass.Calendar++-- | 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:+--+-- > mempty { timeDiffMonths = 1 } `mappend` mempty { timeDiffSeconds = 24 }+--+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++        i64 :: Int -> Int64+        i64 = fromIntegral++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)++-- | 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++-- | 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++-- | add to a DateTime+dateTimeAdd :: DateTime -> TimeDiff -> DateTime+dateTimeAdd dt td =+    dateTimeFromUnixEpoch $ elapsedTimeAdd (dateTimeToUnixEpoch dt) td++-- | 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 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++-- | 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 }++{- 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++-- | 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,297 @@+-- |+-- 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 #-}+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+    ) 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)++-- | 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+    | Format_MicroSecond+    | Format_NanoSecond -}+    | Format_TimezoneName   -- ^ timezone name (e.g. GMT, PST). not implemented yet+    -- | Format_TimezoneOffset -- ^ timeoffset offset (+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 f = timeFormatFctName f+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 ('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 -- timezone offset with colon +HH:MM+        ]+      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+  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 (todHour tm)+        fmtToString Format_Minute   = pad2 (todMin tm)+        fmtToString Format_Second   = pad2 (todSec tm)+        fmtToString Format_UnixSecond = show unixSecs+        fmtToString Format_TimezoneName   = "" --+        fmtToString Format_Tz_Offset = show tz+        fmtToString Format_TzHM = show tzOfs+        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+        tzOfs@(TimezoneOffset tz) = maybe (TimezoneOffset 0) id $ timeGetTimezone t++        -- format a number to 4 stricly+        --pad4t v = pad4 (v `mod` 10000)++-- | 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+  where (TimeFormatString fmtElems) = toFormat fmt++        loop acc []    s  = Right (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) $ is4Digit s+        processOne acc Format_Year2    s = onSuccess+            (\y -> let year = if y < 70 then y + 2000 else y + 1900 in modDate (setYear year) acc)+            $ is2Digit s+        processOne acc Format_Month2   s =+            onSuccess (\m -> modDate (setMonth $ toEnum ((m - 1) `mod` 12)) acc) $ is2Digit s+        processOne acc Format_Day2     s =+            onSuccess (\d -> modDate (setDay d) acc) $ is2Digit s+        processOne acc Format_Hour s =+            onSuccess (\h -> modTime (setHour h) acc) $ is2Digit s+        processOne acc Format_Minute s =+            onSuccess (\mi -> modTime (setMin mi) acc) $ is2Digit s+        processOne acc Format_Second s =+            onSuccess (\sec -> modTime (setSec sec) acc) $ is2Digit 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 (c:s) =+            parseHMSign True acc c s+        processOne acc Format_TzHM (c:s) =+            parseHMSign False acc c 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 = (read [h1,h2] * 60) + read [m1,m2]++        onSuccess f (Right (v, s')) = Right (f v, s')+        onSuccess _ (Left s)        = Left s++        is4Digit (a:b:c:d:s)+            | allDigits [a,b,c,d] = Right (read (a:b:c:d:[]), s)+            | otherwise           = Left ("not digits chars: " ++ show [a,b,c,d])+        is4Digit _                = Left ("not enough chars")++        is2Digit (a:b:s)+            | isDigit a && isDigit b = Right (read (a:b:[]), s)+            | otherwise              = Left ("not digits chars: " ++ show [a,b])+        is2Digit _                 = Left ("not enough chars")++        isNumber :: (Read a, Num a) => String -> Either String (a, String)+        isNumber s =+            case span isDigit s of+                ("",s2) -> Left ("no digits chars:" ++ s2)+                (s1,s2) -> Right (read s1, s2)++        allDigits = and . map isDigit++        ini = LocalTime (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)++        setYear  y (Date _ m d) = Date y m d+        setMonth m (Date y _ d) = Date y m d+        setDay   d (Date y m _) = Date y m d+        setHour  h (TimeOfDay _ m s ns) = TimeOfDay h m s ns+        setMin   m (TimeOfDay h _ s ns) = TimeOfDay h m s ns+        setSec   s (TimeOfDay h m _ ns) = TimeOfDay h m s ns++-- | 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
+ Data/Hourglass/Internal.hs view
@@ -0,0 +1,26 @@+-- |+-- Module      : Data.Hourglass.Internal+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- System lowlevel functions+--+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}++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,150 @@+-- |+-- 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)+        toElapsedP :: CTime -> CLong -> ElapsedP+        toElapsedP (CTime sec) nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec)++-- | 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)+        toElapsed :: CTime -> Elapsed+        toElapsed (CTime sec) = Elapsed $ Seconds (fromIntegral sec)++foreign import ccall unsafe "hourglass_clock_calendar"+    c_clock_get :: Ptr CLong -> IO ()++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)++-- | 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,70 @@+-- |+-- 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 = 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 = fromIntegral++systemGetTimezone :: IO TimezoneOffset+systemGetTimezone = do+    (_,tzInfo) <- getTimeZoneInformation+    return $ TimezoneOffset $ getTzOffset tzInfo+  where getTzOffset tzInfo = fromIntegral (tziBias tzInfo - tziDaylightBias tzInfo)++systemGetElapsedP :: IO ElapsedP+systemGetElapsedP = toElapsedP `fmap` getSystemTimeAsFileTime++systemGetElapsed :: IO Elapsed+systemGetElapsed = toElapsed `fmap` getSystemTimeAsFileTime
+ Data/Hourglass/Local.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+-- |+-- Module      : Data.Hourglass.Local+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- Local time = global time + timezone+--+module Data.Hourglass.Local+    (+    -- * Local time+    -- ** Local time type+      LocalTime(..)+    -- ** Local time creation and manipulation+    , localTime+    , localTimeToGlobal+    , localTimeSetTimezone+    , localTimeConvert+    ) where++import Data.Hourglass.Types+import Data.Hourglass.Time+import Data.Hourglass.Diff++-- | Local time representation+--+-- this is a loca 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++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+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++-- | Get back a global time value+localTimeToGlobal :: Time t => LocalTime t -> t+localTimeToGlobal (LocalTime local tz) = timeConvert $ elapsedTimeAddSecondsP (timeGetElapsedP local) tzSecs+  where tzSecs = negate $ timezoneOffsetToSeconds tz++-- | 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,198 @@+-- |+-- 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 GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+module Data.Hourglass.Time+    (+    -- * Generic time classes+      Time(..)+    , Timeable(..)++    -- * Elapsed time+    , Elapsed(..)+    , ElapsedP(..)++    -- * Generic conversion+    , timeConvert++    -- * Date and Time+    , timeGetDate+    , timeGetDateTimeOfDay+    , timeGetTimeOfDay++    -- * Arithmetic+    , TimeDiff(..)+    , timeAdd+    , timeDiff+    , timeDiffP+    ) 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++    -- | 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.+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)++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)++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)++{-# 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++{-# 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++{-# 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++{-# 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+--+-- example:+--+-- > t1 `timeAdd` mempty { timeDiffHours = 12 }+timeAdd :: Time t => t -> TimeDiff -> t+timeAdd t td = timeFromElapsedP $ elapsedTimeAddP (timeGetElapsedP t) td++-- | 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,175 @@+{-# 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 referencial works under the Windows platform or any other platforms.+--+module Data.Hourglass.Types+    (+    -- * Time units+      NanoSeconds(..)+    , Seconds(..)+    -- * Time enumeration+    , Month(..)+    , WeekDay(..)+    -- * Timezone+    , TimezoneOffset(..)+    , timezoneOffsetToSeconds+    -- * 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)++-- | Nanoseconds+newtype NanoSeconds = NanoSeconds Int+    deriving (Read,Eq,Ord,Num,Data,Typeable,NFData)++instance Show NanoSeconds where+    show (NanoSeconds v) = shows v "ns"++-- | Number of seconds without a referencial.+--+-- 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,Num,Data,Typeable,NFData)++instance Show Seconds where+    show (Seconds s) = shows s "s"++-- | 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+    (ElapsedP e1 ns1) + (ElapsedP e2 ns2) = ElapsedP (e1+e2) (ns1+ns2)+    (ElapsedP e1 ns1) - (ElapsedP e2 ns2) = ElapsedP (e1-e2) (ns1-ns2)+    (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++instance Real ElapsedP where+    -- FIXME+    toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds ns)) =+        fromIntegral s + (1000000000 % fromIntegral ns)++-- | Month of the year+data Month =+      January+    | February+    | March+    | April+    | May+    | June+    | July+    | August+    | September+    | October+    | November+    | December+    deriving (Show,Eq,Ord,Enum,Data,Typeable)++-- | 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)++-- | Offset against UTC in minutes+--+-- * 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+--+newtype TimezoneOffset = TimezoneOffset+    { timezoneOffsetToMinutes :: Int -- ^ return the number of minutes+    } deriving (Eq,Ord,Data,Typeable)++-- | 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++-- | 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,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 #-} !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 */+    , todNSec :: {-# UNPACK #-} !NanoSeconds -- ^ nanoseconds, between 0 and 999999999 */+    } deriving (Show,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,Eq,Ord,Data,Typeable)++instance NFData DateTime where+    rnf (DateTime d t) = rnf d `seq` rnf t `seq` ()
+ Data/Hourglass/Utils.hs view
@@ -0,0 +1,23 @@+-- |+-- 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
+ 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,74 @@+hourglass+=========++Hourglass is a simple time library.++Documentation: [hourglass on hackage](http://hackage.haskell.org/package/hourglass)++Design+------++One of the key design are the Timeable and Time type classes.+Time representation of the same time value are interchangeable and easy to convert+between each other.  This also allow the user to define new time types that+interact with the same functions as the built-in types.++For example:++    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 limitation 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:++    ------- with time+    import Data.Time.Clock.POSIX+    ptime <- getPOSIXTime++    ------- with hourglass+    import System.Hourglass+    ptime <- getCurrentElapsed++* getting current date year:++    ------- 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 <$> getCurrentElapsed++* creating a time representation of "4th May 1970 15:12:24"++    ------- 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)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Hourglass.hs view
@@ -0,0 +1,46 @@+-- |+-- 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+--+module System.Hourglass+    (+    -- * Current time in computer friendly format+      timeCurrent+    , timeCurrentP+    -- * Current time in human friendly DateTime format+    , dateCurrent+    -- * System timezone+    , timezoneCurrent+    ) where++import Control.Applicative+import Data.Hourglass.Types+import Data.Hourglass.Time+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 time+--+-- This is equivalent to:+--+-- > timeGetDateTimeOfDay `fmap` timeCurrentP+dateCurrent :: IO DateTime+dateCurrent = timeGetDateTimeOfDay <$> timeCurrentP++-- | Get the current timezone offset+--+-- This include daylight saving time when in operation.+timezoneCurrent :: IO TimezoneOffset+timezoneCurrent = systemGetTimezone
+ cbits/unix.c view
@@ -0,0 +1,31 @@+/*+ * lowlevel binder for macosx and + */+#include <time.h>+#ifdef __MACH__+#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)+{+#ifdef MACH+	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+}
+ hourglass.cabal view
@@ -0,0 +1,86 @@+Name:                hourglass+Version:             0.1.0+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.+License:             BSD3+License-file:        LICENSE+Copyright:           Vincent Hanquez <vincent@snarc.org>+Author:              Vincent Hanquez <vincent@snarc.org>+Maintainer:          vincent@snarc.org+Category:            Time+Stability:           experimental+Build-Type:          Simple+Homepage:            http://github.com/vincenthz/hs-hourglass+Cabal-Version:       >=1.10+extra-source-files:  README.md++Library+  Exposed-modules:   Data.Hourglass+                   , Data.Hourglass.Types+                   , Data.Hourglass.Epoch+                   , 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+  Build-depends:     base >= 4 && < 5+                   , deepseq+  ghc-options:       -Wall -fwarn-tabs+  Default-Language:  Haskell2010+  if os(windows)+     cpp-options:    -DWINDOWS+     Build-depends:  Win32+     Other-modules:  Data.Hourglass.Internal.Win+  else+     Other-modules:  Data.Hourglass.Internal.Unix+     c-sources:      cbits/unix.c++Test-Suite test-hourglass+  type:              exitcode-stdio-1.0+  hs-source-dirs:    tests+  Main-is:           Tests.hs+  Build-Depends:     base >= 3 && < 5+                   , mtl+                   , QuickCheck >= 2+                   , HUnit+                   , test-framework+                   , test-framework-quickcheck2+                   , test-framework-hunit+                   , hourglass+                   , deepseq+                   -- to test against some other reference+                   , time+                   , old-locale+  ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures+  Default-Language:  Haskell2010+  if os(windows)+     cpp-options:    -DWINDOWS++Benchmark bench-hourglass+  hs-source-dirs:    tests+  Main-Is:           Bench.hs+  type:              exitcode-stdio-1.0+  Default-Language:  Haskell2010+  Build-depends:     base >= 4 && < 5+                   , bytestring+                   , criterion+                   , mtl+                   , deepseq+                   , hourglass+                   -- to benchmark against other reference+                   , time+                   , old-locale++source-repository head+  type: git+  location: git://github.com/vincenthz/hs-hourglass
+ tests/Bench.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE ViewPatterns #-}+module Main (main) where++import Criterion.Main+import Data.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+       --(DateTimeP (Date y m d) (TimeOfDayP (TimeOfDay h mi sec) _)) = localTimeToGlobal localtime++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)+    ]++-- T.posixSecondsToUTCTime timePosix++main = defaultMain+    [ bgroup "highlevel" $ concatMap toHighLevel timePosixDict+    , bgroup "to-calendar"  $ concatMap toCalendar timePosixDict+    , bgroup "to-posix" $ concatMap toPosix dateDict+    ]+  where toHighLevel (posixHourglass, posixTime) =+            [ bench (show $ posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass+            , bench (show $ posixTime) $ nf T.posixSecondsToUTCTime posixTime+            ]+        toCalendar (posixHourglass, posixTime) =+            [ bench (show $ posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass+            , bench (show $ posixTime) $ nf (timeToTuple . T.posixSecondsToUTCTime) posixTime+            ]+        toPosix v =+            [ bench (n v) $ nf hourglass v+            , bench (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 h mi 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)++            --bench (show $ fromIntegral posixHourglass) $ nf (
+ tests/Tests.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+module Main where++import Control.Applicative+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 Data.Word+import Data.Int+import Data.Hourglass+import Data.Hourglass.Epoch+--import System.Hourglass++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+import qualified System.Locale as T++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+        , h' == h, 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++-- 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 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 Month where+    arbitrary = elements [January ..]+instance Arbitrary DateTime where+    arbitrary = DateTime <$> arbitrary <*> arbitrary+instance Arbitrary Date where+    arbitrary = Date <$> choose dateRange+                     <*> arbitrary+                     <*> choose (1,28)+instance Arbitrary TimeOfDay where+    arbitrary = TimeOfDay <$> choose (0,23)+                          <*> choose (0,59)+                          <*> 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)++tests knowns =+    [ 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 "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` localTime (localTimeGetTimezone l) 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) ->+            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')+        ]+    , 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  = timeParseE ISO8601_Date fmt+                md2  = T.parseTime T.defaultTimeLocale fmt "%F"+             in case (ed1,md2) of+                    (Left _, Nothing)         -> error ("both cannot parse: " ++ show fmt)+                    (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 = timeParseE "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)) =+            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))++        tuple12 (a,b,_,_) = (a,b)+        tuple13 (a,_,b,_) = (a,b)++        calTimeFormatTimeISO8601 timePosix =+            T.formatTime T.defaultTimeLocale "%F" (T.posixSecondsToUTCTime timePosix)++main = do+    knowns <- E.catch (map parseTimeConv . lines <$> readFile "test-time-db")+                      (\(_ :: E.SomeException) -> return [])+    defaultMain (tests knowns)