time-exts 1.0.1 → 1.0.2
raw patch · 7 files changed
+377/−118 lines, 7 files
Files
- ._LICENSE binary
- src/Data/Time/Exts/Base.hs +65/−23
- src/Data/Time/Exts/C.hsc +2/−1
- src/Data/Time/Exts/Local.hs +197/−63
- src/Data/Time/Exts/Unix.hs +87/−22
- src/Data/Time/Exts/Zone.hs +25/−8
- time-exts.cabal +1/−1
− ._LICENSE
binary file changed (171 → absent bytes)
src/Data/Time/Exts/Base.hs view
@@ -14,6 +14,7 @@ module Data.Time.Exts.Base ( + -- * Classes Date(..) , Zone(..) , DateZone(..)@@ -21,11 +22,13 @@ , DateTimeZone(..) , DateTimeMath(..) + -- * Structs , DateStruct(..) , DateZoneStruct(..) , DateTimeStruct(..) , DateTimeZoneStruct(..) + -- * Components , Year(..) , Month(..) , Day(..)@@ -38,21 +41,25 @@ , Nanos(..) , Picos(..) + -- * Pretty , Pretty(..) , prettyMonth , prettyDay , prettyHour + -- * Fractions , properFracMillis , properFracMicros , properFracNanos , properFracPicos + -- * Durations , epochToDate , epochToYear , yearToMonth , dateToTime + -- * Utilities , isLeapYear ) where@@ -88,9 +95,11 @@ class DateTimeMath a b where plus :: a -> b -> a +-- | Show a timestamp in a more human-readable format than the default 'Show' instance. class Pretty a where pretty :: a -> String +-- | A struct with date components. data DateStruct = DateStruct { _d_year :: {-# UNPACK #-} !Year -- ^ year , _d_mon :: {-# UNPACK #-} !Month -- ^ month@@ -98,6 +107,7 @@ , _d_wday :: !DayOfWeek -- ^ day of week } deriving (Eq,Generic,Ord,Show,Typeable) +-- | A struct with date and zone components. data DateZoneStruct = DateZoneStruct { _dz_year :: {-# UNPACK #-} !Year -- ^ year , _dz_mon :: {-# UNPACK #-} !Month -- ^ month@@ -106,6 +116,7 @@ , _dz_zone :: !TimeZone -- ^ time zone } deriving (Eq,Generic,Ord,Show,Typeable) +-- | A struct with date and time components. data DateTimeStruct = DateTimeStruct { _dt_year :: {-# UNPACK #-} !Year -- ^ year , _dt_mon :: {-# UNPACK #-} !Month -- ^ month@@ -116,6 +127,7 @@ , _dt_sec :: {-# UNPACK #-} !Double -- ^ second } deriving (Eq,Generic,Ord,Show,Typeable) +-- | A struct with date, time and zone components. data DateTimeZoneStruct = DateTimeZoneStruct { _dtz_year :: {-# UNPACK #-} !Year -- ^ year , _dtz_mon :: {-# UNPACK #-} !Month -- ^ month@@ -127,17 +139,47 @@ , _dtz_zone :: !TimeZone -- ^ time zone } deriving (Eq,Generic,Ord,Show,Typeable) -newtype Year = Year {getYear :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Month = Month {getMonth :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Day = Day {getDay :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Hour = Hour {getHour :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Minute = Minute {getMinute :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Second = Second {getSecond :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Millis = Millis {getMillis :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Micros = Micros {getMicros :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Nanos = Nanos {getNanos :: Int32} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)-newtype Picos = Picos {getPicos :: Int64} deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)+-- | Year.+newtype Year = Year {getYear :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON) +-- | Month.+newtype Month = Month {getMonth :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Day.+newtype Day = Day {getDay :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Hour.+newtype Hour = Hour {getHour :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Minute.+newtype Minute = Minute {getMinute :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Second.+newtype Second = Second {getSecond :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Millisecond.+newtype Millis = Millis {getMillis :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Microsecond.+newtype Micros = Micros {getMicros :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Nanosecond.+newtype Nanos = Nanos {getNanos :: Int32}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Picosecond.+newtype Picos = Picos {getPicos :: Int64}+ deriving (Bounded,Enum,Eq,FromJSON,Generic,Integral,Num,Ord,PrintfArg,Random,Real,ToJSON)++-- | Day of the week. data DayOfWeek = Sunday | Monday@@ -175,11 +217,11 @@ instance ToJSON DateTimeZoneStruct instance ToJSON DayOfWeek --- | Shows the given numeric value as a string.+-- | Show the given numeric value as a string. parens :: Num a => Ord a => Show a => a -> String parens x = if x < 0 then '(' : show x ++ ")" else show x --- | Shows the given month as a string. +-- | Show the given month as a string. prettyMonth :: Month -> String prettyMonth = \ case 01 -> "January"@@ -196,7 +238,7 @@ 12 -> "December" _ -> error "prettyMonth: unknown month" --- | Shows the given day of the month as a string.+-- | Show the given day of the month as a string. prettyDay :: Day -> String prettyDay Day{getDay} = if getDay <= 0 || 32 <= getDay@@ -208,7 +250,7 @@ _ -> str ++ "th" where str = show getDay --- | Returns the given hour in AM-PM format. +-- | Return the given hour in AM-PM format. prettyHour :: Hour -> (Hour, String) prettyHour hour = if | hour < 00 -> error "prettyHour: unknown hour"@@ -218,41 +260,41 @@ | hour <= 23 -> (hour - 12, "PM") | otherwise -> error "prettyHour: unknown hour" --- | Decomposes a floating point number into second and millisecond components.+-- | Decompose a floating point number into second and millisecond components. properFracMillis :: Floating a => RealFrac a => a -> (Second, Millis) properFracMillis millis = if rem == 1000 then (sec + 1, 0) else result where result@(sec, rem) = fmap (round . (*) 1000) $ properFraction millis --- | Decomposes a floating point number into second and microsecond components.+-- | Decompose a floating point number into second and microsecond components. properFracMicros :: Floating a => RealFrac a => a -> (Second, Micros) properFracMicros micros = if rem == 1000000 then (sec + 1, 0) else result where result@(sec, rem) = fmap (round . (*) 1000000) $ properFraction micros --- | Decomposes a floating point number into second and nanosecond components.+-- | Decompose a floating point number into second and nanosecond components. properFracNanos :: Floating a => RealFrac a => a -> (Second, Nanos) properFracNanos nanos = if rem == 1000000000 then (sec + 1, 0) else result where result@(sec, rem) = fmap (round . (*) 1000000000) $ properFraction nanos --- | Decomposes a floating point number into second and picosecond components.+-- | Decompose a floating point number into second and picosecond components. properFracPicos :: Floating a => RealFrac a => a -> (Second, Picos) properFracPicos picos = if rem == 1000000000000 then (sec + 1, 0) else result where result@(sec, rem) = fmap (round . (*) 1000000000000) $ properFraction picos --- | Calculates the number of days that have+-- | Calculate the number of days that have -- elapsed between Unix epoch and the given date. epochToDate :: Year -> Month -> Day -> Day epochToDate year mon mday = epochToYear year + yearToMonth mon leap + mday - 1 where leap = isLeapYear year --- | Calculates the number of days that have+-- | Calculate the number of days that have -- elapsed between Unix epoch and the given year. epochToYear :: Year -> Day epochToYear Year{getYear} = Day ((getYear - 1970) * 365 + (getYear - 1969) `div` 004 - (getYear - 1901) `div` 100 + (getYear - 1601) `div` 400) --- | Calculates the number of days that have +-- | Calculate the number of days that have -- elapsed between January 1st and the given month. yearToMonth :: Month -> Bool -> Day yearToMonth mon leap =@@ -270,12 +312,12 @@ 09 -> 243; 10 -> 273; 11 -> 304; 12 -> 334 __ -> error "yearToMonth: month not supported" --- | Calculates the number of seconds that have+-- | Calculate the number of seconds that have -- elapsed between midnight and the given time. dateToTime :: Hour -> Minute -> Second -> Second dateToTime Hour{getHour} Minute{getMinute} sec = Second ((getHour * 3600) + (getMinute * 60)) + sec --- | Checks if the given year is a leap year.+-- | Check if the given year is a leap year. isLeapYear :: Year -> Bool isLeapYear year = year `mod` 400 == 0 || (not (year `mod` 100 == 0) && year `mod` 4 == 0)
src/Data/Time/Exts/C.hsc view
@@ -5,6 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS -Wall #-} +-- | This module was generated by hsc2hs for profiling, testing and benchmarking purposes. module Data.Time.Exts.C where import Data.Convertible (Convertible(..))@@ -55,7 +56,7 @@ instance Convertible C'tm CTime where safeConvert = Right . unsafeLocalState . flip with c'timegm --- | Gets the current Unix date and time from the system clock.+-- | Get the current Unix date and time from the system clock. getTimeOfDay :: IO C'timeval getTimeOfDay = with (C'timeval 0 0) $ \ ptr -> c'gettimeofday ptr nullPtr >>= getResult ptr where getResult ptr 0 = peek ptr
src/Data/Time/Exts/Local.hs view
@@ -12,9 +12,13 @@ {-# OPTIONS -Wall #-} {-# OPTIONS -fno-warn-type-defaults #-} +-- | Types and functions for local timestamps. module Data.Time.Exts.Local ( + -- * Local Class Local++ -- * Local Timestamps , LocalDate(..) , LocalDateTime(..) , LocalDateTimeMillis(..)@@ -22,6 +26,7 @@ , LocalDateTimeNanos(..) , LocalDateTimePicos(..) + -- * Create Local Timestamps , createLocalDate , createLocalDateTime , createLocalDateTimeMillis@@ -29,6 +34,7 @@ , createLocalDateTimeNanos , createLocalDateTimePicos + -- * Get Current Local Timestamps , getCurrentLocalDate , getCurrentLocalDateTime , getCurrentLocalDateTimeMillis@@ -36,6 +42,7 @@ , getCurrentLocalDateTimeNanos , getCurrentLocalDateTimePicos + -- Get Current Local Timestamps Using Preloaded Transition Times , getCurrentLocalDate' , getCurrentLocalDateTime' , getCurrentLocalDateTimeMillis'@@ -43,9 +50,11 @@ , getCurrentLocalDateTimeNanos' , getCurrentLocalDateTimePicos' + -- * Transition Times , TransitionTimes , getTransitionTimes + -- * Base Conversions , baseUnixToUTC , baseUTCToUnix @@ -75,42 +84,50 @@ import System.Random (Random(..)) import Text.Printf (printf) +-- | A class of local timestamps. class Local x +-- | A local date. data LocalDate = LocalDate { _loc_day_base :: {-# UNPACK #-} !Int32 -- ^ days since Unix epoch , _loc_day_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone } deriving (Eq,Generic,Typeable) +-- | A local date and time. data LocalDateTime = LocalDateTime { _loc_sec_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds) , _loc_sec_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone } deriving (Eq,Generic,Typeable) +-- | A local date and time with millisecond granularity. data LocalDateTimeMillis = LocalDateTimeMillis { _loc_mil_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds) , _loc_mil_mill :: {-# UNPACK #-} !Int16 -- ^ milliseconds , _loc_mil_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone } deriving (Eq,Generic,Typeable) +-- | A local date and time with microsecond granularity. data LocalDateTimeMicros = LocalDateTimeMicros { _loc_mic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds) , _loc_mic_micr :: {-# UNPACK #-} !Int32 -- ^ microseconds , _loc_mic_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone } deriving (Eq,Generic,Typeable) +-- | A local date and time with nanosecond granularity. data LocalDateTimeNanos = LocalDateTimeNanos { _loc_nan_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds) , _loc_nan_nano :: {-# UNPACK #-} !Int32 -- ^ nanoseconds , _loc_nan_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone } deriving (Eq,Generic,Typeable) +-- | A local date and time with picosecond granularity. data LocalDateTimePicos = LocalDateTimePicos { _loc_pic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds) , _loc_pic_pico :: {-# UNPACK #-} !Int64 -- ^ picoseconds , _loc_pic_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone } deriving (Eq,Generic,Typeable) +-- | A list of transition times. type TransitionTimes = [LocalDateTime] mkLabels [''LocalDate@@ -185,37 +202,37 @@ (base, secs) = decompUTCBase _loc_pic_base _loc_pic_zone instance Convertible Calendar.Day LocalDate where- safeConvert Calendar.ModifiedJulianDay{..} = Right $ LocalDate base 0+ safeConvert Calendar.ModifiedJulianDay{..} = Right $ LocalDate base 17 where base = fromInteger toModifiedJulianDay - 40587 instance Convertible UTCTime LocalDateTime where- safeConvert UTCTime{..} = Right $ LocalDateTime base 0+ safeConvert UTCTime{..} = Right $ LocalDateTime base 17 where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587 base = baseUnixToUTC $ days * 86400 + truncate utctDayTime instance Convertible UTCTime LocalDateTimeMillis where- safeConvert UTCTime{..} = Right $ LocalDateTimeMillis base mill 0+ safeConvert UTCTime{..} = Right $ LocalDateTimeMillis base mill 17 where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587 base = baseUnixToUTC $ days * 86400 + sec mill = truncate $ frac * 1000 (sec, frac) = properFraction utctDayTime instance Convertible UTCTime LocalDateTimeMicros where- safeConvert UTCTime{..} = Right $ LocalDateTimeMicros base micr 0+ safeConvert UTCTime{..} = Right $ LocalDateTimeMicros base micr 17 where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587 base = baseUnixToUTC $ days * 86400 + sec micr = truncate $ frac * 1000000 (sec, frac) = properFraction utctDayTime instance Convertible UTCTime LocalDateTimeNanos where- safeConvert UTCTime{..} = Right $ LocalDateTimeNanos base nano 0+ safeConvert UTCTime{..} = Right $ LocalDateTimeNanos base nano 17 where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587 base = baseUnixToUTC $ days * 86400 + sec nano = truncate $ frac * 1000000000 (sec, frac) = properFraction utctDayTime instance Convertible UTCTime LocalDateTimePicos where- safeConvert UTCTime{..} = Right $ LocalDateTimePicos base pico 0+ safeConvert UTCTime{..} = Right $ LocalDateTimePicos base pico 17 where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587 base = baseUnixToUTC $ days * 86400 + sec pico = truncate $ frac * 1000000000000@@ -444,12 +461,14 @@ case randomR (43200, 000000000999) g' of { (mill, g'' ) -> case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimeMillis base mill zone, g''') } } } randomR (a, b) g =- case randomR (minval, maxval) g of { (base_mill, g' ) -> - case randomR (000000, 000051) g' of { (zone , g'') ->+ case randomR (minTime, maxTime) g of { (base_mill, g' ) -> + case randomR (minZone, maxZone) g' of { (zone , g'') -> let (base, mill) = (***) fromInteger fromInteger $ divMod base_mill 1000 in (LocalDateTimeMillis base mill zone, g'') } }- where minval = toInteger (_loc_mil_mill a) + toInteger (_loc_mil_base a) * 1000- maxval = toInteger (_loc_mil_mill b) + toInteger (_loc_mil_base b) * 1000+ where minTime = toInteger (_loc_mil_mill a) + toInteger (_loc_mil_base a) * 1000+ maxTime = toInteger (_loc_mil_mill b) + toInteger (_loc_mil_base b) * 1000+ minZone = _loc_mil_zone a+ maxZone = _loc_mil_zone b instance Random LocalDateTimeMicros where random g =@@ -457,12 +476,14 @@ case randomR (43200, 000000999999) g' of { (micr, g'' ) -> case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimeMicros base micr zone, g''') } } } randomR (a, b) g =- case randomR (minval, maxval) g of { (base_micr, g' ) -> - case randomR (000000, 000051) g' of { (zone , g'') ->+ case randomR (minTime, maxTime) g of { (base_micr, g' ) -> + case randomR (minZone, maxZone) g' of { (zone , g'') -> let (base, micr) = (***) fromInteger fromInteger $ divMod base_micr 1000000 in (LocalDateTimeMicros base micr zone, g'') } }- where minval = toInteger (_loc_mic_micr a) + toInteger (_loc_mic_base a) * 1000000- maxval = toInteger (_loc_mic_micr b) + toInteger (_loc_mic_base b) * 1000000+ where minTime = toInteger (_loc_mic_micr a) + toInteger (_loc_mic_base a) * 1000000+ maxTime = toInteger (_loc_mic_micr b) + toInteger (_loc_mic_base b) * 1000000+ minZone = _loc_mic_zone a+ maxZone = _loc_mic_zone b instance Random LocalDateTimeNanos where random g =@@ -470,12 +491,14 @@ case randomR (43200, 000999999999) g' of { (nano, g'' ) -> case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimeNanos base nano zone, g''') } } } randomR (a, b) g =- case randomR (minval, maxval) g of { (base_nano, g' ) -> - case randomR (000000, 000051) g' of { (zone , g'') ->+ case randomR (minTime, maxTime) g of { (base_nano, g' ) -> + case randomR (minZone, maxZone) g' of { (zone , g'') -> let (base, nano) = (***) fromInteger fromInteger $ divMod base_nano 1000000000 in (LocalDateTimeNanos base nano zone, g'') } }- where minval = toInteger (_loc_nan_nano a) + toInteger (_loc_nan_base a) * 1000000000- maxval = toInteger (_loc_nan_nano b) + toInteger (_loc_nan_base b) * 1000000000+ where minTime = toInteger (_loc_nan_nano a) + toInteger (_loc_nan_base a) * 1000000000+ maxTime = toInteger (_loc_nan_nano b) + toInteger (_loc_nan_base b) * 1000000000+ minZone = _loc_nan_zone a+ maxZone = _loc_nan_zone b instance Random LocalDateTimePicos where random g =@@ -483,12 +506,14 @@ case randomR (43200, 999999999999) g' of { (pico, g'' ) -> case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimePicos base pico zone, g''') } } } randomR (a, b) g =- case randomR (minval, maxval) g of { (base_pico, g' ) -> - case randomR (000000, 000051) g' of { (zone , g'') ->+ case randomR (minTime, maxTime) g of { (base_pico, g' ) -> + case randomR (minZone, maxZone) g' of { (zone , g'') -> let (base, pico) = (***) fromInteger fromInteger $ divMod base_pico 1000000000000 in (LocalDateTimePicos base pico zone, g'') } }- where minval = toInteger (_loc_pic_pico a) + toInteger (_loc_pic_base a) * 1000000000000- maxval = toInteger (_loc_pic_pico b) + toInteger (_loc_pic_base b) * 1000000000000+ where minTime = toInteger (_loc_pic_pico a) + toInteger (_loc_pic_base a) * 1000000000000+ maxTime = toInteger (_loc_pic_pico b) + toInteger (_loc_pic_base b) * 1000000000000+ minZone = _loc_pic_zone a+ maxZone = _loc_pic_zone b instance Show LocalDate where show date = printf str _dz_year _dz_mon _dz_mday abbr@@ -642,7 +667,11 @@ instance Zone LocalDateTimePicos where toZone time = flip (set loc_pic_zone) time . fromIntegral . fromEnum --- | Creates a local date.+-- | Create a local date.+-- +-- > >>> createLocalDate 2013 11 03 Pacific_Standard_Time +-- > 2013-11-03 PST+-- createLocalDate :: Year -> Month -> Day -> TimeZone -> LocalDate createLocalDate year month day zone = if minBound <= date && date <= maxBound then date@@ -650,7 +679,11 @@ where date = LocalDate base . fromIntegral $ fromEnum zone base = fromIntegral $ epochToDate year month day --- | Creates a local date and time.+-- | Create a local date and time.+--+-- > >>> createLocalDateTime 2013 11 03 22 55 52 South_Africa_Standard_Time +-- > 2013-11-03 22:55:52 SAST+-- createLocalDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> TimeZone -> LocalDateTime createLocalDateTime year month day hour minute second zone = if minBound <= time && time <= maxBound then time@@ -660,9 +693,13 @@ base = baseUnixToUTC ((fromIntegral days * 86400) + (fromIntegral hour * 03600) + (fromIntegral minute * 00060) -- (offset zone * 00060)) + fromIntegral second+ (getOffset zone * 00060)) + fromIntegral second --- | Creates a local date and time with millisecond granularity.+-- | Create a local date and time with millisecond granularity.+--+-- > >>> createLocalDateTimeMillis 2013 11 03 13 57 43 830 Mountain_Standard_Time+-- > 2013-11-03 13:57:43.830 MST+-- createLocalDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> TimeZone -> LocalDateTimeMillis createLocalDateTimeMillis year month day hour minute second millis zone = if minBound <= time && time <= maxBound then time@@ -674,9 +711,13 @@ base = baseUnixToUTC ((fromIntegral days * 86400) + (fromIntegral hour * 03600) + (fromIntegral minute * 00060) -- (offset zone * 00060)) + fromIntegral second + adds+ (getOffset zone * 00060)) + fromIntegral second + adds --- | Creates a local date and time with microsecond granularity.+-- | Create a local date and time with microsecond granularity.+--+-- > >>> createLocalDateTimeMicros 2013 11 03 21 01 42 903539 Coordinated_Universal_Time +-- > 2013-11-03 21:01:42.903539 UTC+-- createLocalDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> TimeZone -> LocalDateTimeMicros createLocalDateTimeMicros year month day hour minute second micros zone = if minBound <= time && time <= maxBound then time@@ -688,9 +729,13 @@ base = baseUnixToUTC ((fromIntegral days * 86400) + (fromIntegral hour * 03600) + (fromIntegral minute * 00060) -- (offset zone * 00060)) + fromIntegral second + adds+ (getOffset zone * 00060)) + fromIntegral second + adds --- | Creates a local date and time with nanosecond granularity.+-- | Create a local date and time with nanosecond granularity.+--+-- > >>> createLocalDateTimeNanos 2013 11 04 06 05 07 016715087 Japan_Standard_Time +-- > 2013-11-04 06:05:07.016715087 JST+-- createLocalDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> TimeZone -> LocalDateTimeNanos createLocalDateTimeNanos year month day hour minute second nanos zone = if minBound <= time && time <= maxBound then time@@ -702,9 +747,13 @@ base = baseUnixToUTC ((fromIntegral days * 86400) + (fromIntegral hour * 03600) + (fromIntegral minute * 00060) -- (offset zone * 00060)) + fromIntegral second + adds+ (getOffset zone * 00060)) + fromIntegral second + adds --- | Creates a local date and time with picosecond granularity.+-- | Create a local date and time with picosecond granularity.+--+-- > >>> createLocalDateTimePicos 2013 11 03 23 13 56 838238648311 Eastern_European_Time +-- > 2013-11-03 23:13:56.838238648311 EET+-- createLocalDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> TimeZone -> LocalDateTimePicos createLocalDateTimePicos year month day hour minute second picos zone = if minBound <= time && time <= maxBound then time@@ -716,9 +765,9 @@ base = baseUnixToUTC ((fromIntegral days * 86400) + (fromIntegral hour * 03600) + (fromIntegral minute * 00060) -- (offset zone * 00060)) + fromIntegral second + adds+ (getOffset zone * 00060)) + fromIntegral second + adds --- | Decomposes a local date into a human-readable format.+-- | Decompose a local date into a human-readable format. decompLocalDate :: LocalDate -> DateZoneStruct decompLocalDate LocalDate{..} = DateZoneStruct _d_year _d_mon _d_mday _d_wday zone@@ -726,78 +775,101 @@ date = UnixDate _loc_day_base zone = toEnum $ fromIntegral _loc_day_zone --- | Decomposes a local date and time into a human-readable format.+-- | Decompose a local date and time into a human-readable format. decompLocalDateTime :: LocalDateTime -> DateTimeZoneStruct decompLocalDateTime LocalDateTime{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct time (,) base leap = baseUTCToUnix _loc_sec_base zone = toEnum $ fromIntegral _loc_sec_zone- time = UnixDateTime base `plus` (offset zone :: Minute)+ time = UnixDateTime base `plus` (getOffset zone :: Minute) sec = _dt_sec + fromIntegral leap --- | Decomposes a local date and time with millisecond granularity into a human-readable format.+-- | Decompose a local date and time with millisecond granularity into a human-readable format. decompLocalDateTimeMillis :: LocalDateTimeMillis -> DateTimeZoneStruct decompLocalDateTimeMillis LocalDateTimeMillis{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct time (,) base leap = baseUTCToUnix _loc_mil_base zone = toEnum $ fromIntegral _loc_mil_zone- time = UnixDateTime base `plus` (offset zone :: Minute)+ time = UnixDateTime base `plus` (getOffset zone :: Minute) sec = _dt_sec + fromIntegral leap + fromIntegral _loc_mil_mill / 1000 --- | Decomposes a local date and time with microsecond granularity into a human-readable format.+-- | Decompose a local date and time with microsecond granularity into a human-readable format. decompLocalDateTimeMicros :: LocalDateTimeMicros -> DateTimeZoneStruct decompLocalDateTimeMicros LocalDateTimeMicros{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct time (,) base leap = baseUTCToUnix _loc_mic_base zone = toEnum $ fromIntegral _loc_mic_zone- time = UnixDateTime base `plus` (offset zone :: Minute)+ time = UnixDateTime base `plus` (getOffset zone :: Minute) sec = _dt_sec + fromIntegral leap + fromIntegral _loc_mic_micr / 1000000 --- | Decomposes a local date and time with nanosecond granularity into a human-readable format.+-- | Decompose a local date and time with nanosecond granularity into a human-readable format. decompLocalDateTimeNanos :: LocalDateTimeNanos -> DateTimeZoneStruct decompLocalDateTimeNanos LocalDateTimeNanos{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct time (,) base leap = baseUTCToUnix _loc_nan_base zone = toEnum $ fromIntegral _loc_nan_zone- time = UnixDateTime base `plus` (offset zone :: Minute)+ time = UnixDateTime base `plus` (getOffset zone :: Minute) sec = _dt_sec + fromIntegral leap + fromIntegral _loc_nan_nano / 1000000000 --- | Decomposes a local date and time with picosecond granularity into a human-readable format.+-- | Decompose a local date and time with picosecond granularity into a human-readable format. decompLocalDateTimePicos :: LocalDateTimePicos -> DateTimeZoneStruct decompLocalDateTimePicos LocalDateTimePicos{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct time (,) base leap = baseUTCToUnix _loc_pic_base zone = toEnum $ fromIntegral _loc_pic_zone- time = UnixDateTime base `plus` (offset zone :: Minute)+ time = UnixDateTime base `plus` (getOffset zone :: Minute) sec = _dt_sec + fromIntegral leap + fromIntegral _loc_pic_pico / 1000000000000 --- | Decomposes a UTC base into day and second components.+-- | Decompose a UTC base into day and second components. decompUTCBase :: Int64 -> Int16 -> (Int32, Int32) decompUTCBase locBase zone = (newBase, newSecs) where zoneNum = toEnum $ fromIntegral zone (,) nixBase leapSec = baseUTCToUnix locBase- offBase = nixBase + 60 * offset zoneNum+ offBase = nixBase + 60 * getOffset zoneNum newBase = fromIntegral (offBase `div` 86400) newSecs = fromIntegral (nixBase `mod` 86400) + fromIntegral leapSec --- | Gets the current local date from the system clock.+-- | Get the current local date from the system clock.+--+-- > >>> getCurrentLocalDate London +-- > 2013-11-03 GMT+-- getCurrentLocalDate :: City -> IO LocalDate getCurrentLocalDate city = getTransitionTimes city >>= getCurrentLocalDateTime' >>= return . convert --- | Gets the current local date from the system clock with preloaded transition times.+-- | Get the current local date from the system clock using preloaded transition times.+--+-- > >>> ttimes <- getTransitionTimes Tokyo +-- > >>> getCurrentLocalDate' ttimes+-- > 2013-11-04 JST+--+-- Use this function if you need to get the current local date more than once. The+-- use of preloaded transition times will avoid unnecessary parsing of Olson files. getCurrentLocalDate' :: TransitionTimes -> IO LocalDate getCurrentLocalDate' ttimes = getCurrentLocalDateTime' ttimes >>= return . convert --- | Gets the current local date and time from the system clock.+-- | Get the current local date and time from the system clock.+--+-- > >>> getCurrentLocalDateTime New_York +-- > 2013-11-03 16:38:16 EST+-- getCurrentLocalDateTime :: City -> IO LocalDateTime getCurrentLocalDateTime city = getTransitionTimes city >>= getCurrentLocalDateTime' --- | Gets the current local date and time from the system clock with preloaded transition times.+-- | Get the current local date and time from the system clock using preloaded transition+-- times.+--+-- > >>> ttimes <- getTransitionTimes Moscow+-- > >>> getCurrentLocalDateTime' ttimes+-- > 2013-11-04 01:41:50 MSK+--+-- Use this function if you need to get the current local date and time more than once.+-- The use of preloaded transition times will avoid unnecessary parsing of Olson files. getCurrentLocalDateTime' :: TransitionTimes -> IO LocalDateTime getCurrentLocalDateTime' ttimes = do time@(UnixDateTime unix) <- getCurrentUnixDateTime@@ -810,11 +882,24 @@ else let sec = round $ fromIntegral (unix `mod` 86400) / 86400 in return $! LocalDateTime base zone `plus` Second sec --- | Gets the current local date and time with millisecond granularity from the system clock.+-- | Get the current local date and time with millisecond granularity from the system clock.+--+-- > >>> getCurrentLocalDateTimeMillis Auckland+-- > 2013-11-04 10:46:13.123 NZDT+-- getCurrentLocalDateTimeMillis :: City -> IO LocalDateTimeMillis getCurrentLocalDateTimeMillis city = getTransitionTimes city >>= getCurrentLocalDateTimeMillis' --- | Gets the current local date and time with millisecond granularity from the system clock with preloaded transition times.+-- | Get the current local date and time with millisecond granularity from the system clock+-- using preloaded transition times.+--+-- > >>> ttimes <- getTransitionTimes Tehran +-- > >>> getCurrentLocalDateTimeMillis' ttimes+-- > 2013-11-04 01:20:49.435 IRST+--+-- Use this function if you need to get the current local date and time with millisecond+-- granularity more than once. The use of preloaded transition times will avoid unnecessary+-- parsing of Olson files. getCurrentLocalDateTimeMillis' :: TransitionTimes -> IO LocalDateTimeMillis getCurrentLocalDateTimeMillis' ttimes = do time@UnixDateTimeMillis{..} <- getCurrentUnixDateTimeMillis@@ -827,11 +912,24 @@ else let millis = round $ fromIntegral (_uni_mil_base `mod` 86400) / 86.4 in return $! LocalDateTimeMillis base _uni_mil_mill zone `plus` Millis millis --- | Gets the current local date and time with microsecond granularity from the system clock.+-- | Get the current local date and time with microsecond granularity from the system clock.+--+-- > >>> getCurrentLocalDateTimeMicros Tel_Aviv +-- > 2013-11-03 23:55:30.935387 IST+-- getCurrentLocalDateTimeMicros :: City -> IO LocalDateTimeMicros getCurrentLocalDateTimeMicros city = getTransitionTimes city >>= getCurrentLocalDateTimeMicros' --- | Gets the current local date and time with microsecond granularity from the system clock with preloaded transition times.+-- | Get the current local date and time with microsecond granularity from the system clock+-- using preloaded transition times.+--+-- > >>> ttimes <- getTransitionTimes Sao_Paulo+-- > >>> getCurrentLocalDateTimeMicros' ttimes+-- > 2013-11-03 19:58:50.405806 BRST+--+-- Use this function if you need to get the current local date and time with microsecond+-- granularity more than once. The use of preloaded transition times will avoid unnecessary+-- parsing of Olson files. getCurrentLocalDateTimeMicros' :: TransitionTimes -> IO LocalDateTimeMicros getCurrentLocalDateTimeMicros' ttimes = do time@UnixDateTimeMicros{..} <- getCurrentUnixDateTimeMicros@@ -844,11 +942,29 @@ else let micros = round $ fromIntegral (_uni_mic_base `mod` 86400) / 0.0864 in return $! LocalDateTimeMicros base _uni_mic_micr zone `plus` Micros micros --- | Gets the current local date and time with nanosecond granularity from the system clock.+-- | Get the current local date and time with nanosecond granularity from the system clock.+--+-- > >>> getCurrentLocalDateTimeNanos Brussels +-- > 2013-11-03 23:01:07.337488000 CET+--+-- Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant+-- timestamp will have nanosecond granularity, but only microsecond resolution. getCurrentLocalDateTimeNanos :: City -> IO LocalDateTimeNanos getCurrentLocalDateTimeNanos city = getTransitionTimes city >>= getCurrentLocalDateTimeNanos' --- | Gets the current local date and time with nanosecond granularity from the system clock with preloaded transition times.+-- | Get the current local date and time with nanosecond granularity from the system clock+-- using preloaded transition times.+--+-- > >>> ttimes <- getTransitionTimes Mogadishu+-- > >>> getCurrentLocalDateTimeNanos' ttimes+-- > 2013-11-04 01:15:08.664426000 EAT+--+-- Use this function if you need to get the current local date and time with nanosecond+-- granularity more than once. The use of preloaded transition times will avoid unnecessary+-- parsing of Olson files.+--+-- Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant+-- timestamp will have nanosecond granularity, but only microsecond resolution. getCurrentLocalDateTimeNanos' :: TransitionTimes -> IO LocalDateTimeNanos getCurrentLocalDateTimeNanos' ttimes = do time@UnixDateTimeNanos{..} <- getCurrentUnixDateTimeNanos@@ -861,11 +977,29 @@ else let nanos = round $ fromIntegral (_uni_nan_base `mod` 86400) / 0.0000864 in return $! LocalDateTimeNanos base _uni_nan_nano zone `plus` Nanos nanos --- | Gets the current local date and time with picosecond granularity from the system clock.+-- | Get the current local date and time with picosecond granularity from the system clock.+--+-- > >>> getCurrentLocalDateTime Karachi+-- > 2013-11-04 03:18:30 PKT+--+-- Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant+-- timestamp will have picosecond granularity, but only microsecond resolution. getCurrentLocalDateTimePicos :: City -> IO LocalDateTimePicos getCurrentLocalDateTimePicos city = getTransitionTimes city >>= getCurrentLocalDateTimePicos' --- | Gets the current local date and time with picosecond granularity from the system clock with preloaded transition times.+-- | Get the current local date and time with picosecond granularity from the system clock using+-- preloaded transition times.+--+-- > >>> ttimes <- getTransitionTimes Baghdad+-- > >>> getCurrentLocalDateTimePicos' ttimes+-- > 2013-11-04 01:20:57.502906000000 AST+--+-- Use this function if you need to get the current local date and time with picosecond+-- granularity more than once. The use of preloaded transition times will avoid unnecessary+-- parsing of Olson files.+--+-- Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant+-- timestamp will have picosecond granularity, but only microsecond resolution. getCurrentLocalDateTimePicos' :: TransitionTimes -> IO LocalDateTimePicos getCurrentLocalDateTimePicos' ttimes = do time@UnixDateTimePicos{..} <- getCurrentUnixDateTimePicos@@ -878,7 +1012,7 @@ else let picos = round $ fromIntegral (_uni_pic_base `mod` 86400) / 0.0000000864 in return $! LocalDateTimePicos base _uni_pic_pico zone `plus` Picos picos --- | Shows a Local date as a string.+-- | Show a Local date as a string. prettyLocalDate :: LocalDate -> String prettyLocalDate date = printf "%s, %s %s, %04d (%s)" wday mon mday _dz_year abbr@@ -888,7 +1022,7 @@ mday = prettyDay _dz_mday abbr = show (convert _dz_zone :: TimeZoneAbbr) --- | Shows a Local date and time as a string.+-- | Show a Local date and time as a string. prettyLocalDateTime :: DateTimeZone dtz => dtz -> String prettyLocalDateTime time = printf str hour _dtz_min ampm wday mon mday _dtz_year abbr@@ -900,7 +1034,7 @@ abbr = show (convert _dtz_zone :: TimeZoneAbbr) (hour, ampm) = prettyHour _dtz_hour --- | Returns a set of transition times for the given city.+-- | Get a list of transition times for the given city. getTransitionTimes :: City -> IO TransitionTimes getTransitionTimes city = do let file = getOlsonFile city@@ -918,7 +1052,7 @@ base = baseUnixToUTC $ fromIntegral transTime zone = fromIntegral $ fromEnum (convert abbr :: TimeZone) --- | Converts a Unix base into a UTC base.+-- | Convert a Unix base into a UTC base. baseUnixToUTC :: Int64 -> Int64 baseUnixToUTC base = if | base >= 1341100800 -> base + 25@@ -948,7 +1082,7 @@ | base >= 0078796800 -> base + 01 | otherwise -> base + 00 --- | Converts a UTC base into a Unix base and leap second.+-- | Convert a UTC base into a Unix base and leap second. baseUTCToUnix :: Int64 -> (Int64, Second) baseUTCToUnix base = if | base >= 1341100825 -> (base - 0025, 0)
src/Data/Time/Exts/Unix.hs view
@@ -15,9 +15,13 @@ #include "MachDeps.h" +-- | Types and functions for Unix timestamps. module Data.Time.Exts.Unix ( + -- * Unix Class Unix++ -- * Unix Timestamps , UnixDate(..) , UnixDateTime(..) , UnixDateTimeMillis(..)@@ -25,6 +29,7 @@ , UnixDateTimeNanos(..) , UnixDateTimePicos(..) + -- * Create Unix Timestamps , createUnixDate , createUnixDateTime , createUnixDateTimeMillis@@ -32,6 +37,7 @@ , createUnixDateTimeNanos , createUnixDateTimePicos + -- * Get Current Unix Timestamps , getCurrentUnixDate , getCurrentUnixDateTime , getCurrentUnixDateTimeMillis@@ -57,29 +63,36 @@ import System.Random (Random(..)) import Text.Printf (printf) +-- | A class of Unix timestamps. class Unix x +-- | A Unix date. newtype UnixDate = UnixDate Int32 deriving (Eq,FromJSON,Generic,Integral,NFData,Num,Ord,Random,Real,Storable,ToJSON,Typeable) +-- | A Unix date and time. newtype UnixDateTime = UnixDateTime Int64 deriving (Eq,FromJSON,Generic,Integral,NFData,Num,Ord,Random,Real,Storable,ToJSON,Typeable) +-- | A Unix date and time with millisecond granularity. data UnixDateTimeMillis = UnixDateTimeMillis { _uni_mil_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds) , _uni_mil_mill :: {-# UNPACK #-} !Int16 -- ^ millisecinds } deriving (Eq,Generic,Ord,Typeable) +-- | A Unix date and time with microsecond granularity. data UnixDateTimeMicros = UnixDateTimeMicros { _uni_mic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds) , _uni_mic_micr :: {-# UNPACK #-} !Int32 -- ^ microsecinds } deriving (Eq,Generic,Ord,Typeable) +-- | A Unix date and time with nanosecond granularity. data UnixDateTimeNanos = UnixDateTimeNanos { _uni_nan_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds) , _uni_nan_nano :: {-# UNPACK #-} !Int32 -- ^ nanosecinds } deriving (Eq,Generic,Ord,Typeable) +-- | A Unix date and time with picosecond granularity. data UnixDateTimePicos = UnixDateTimePicos { _uni_pic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds) , _uni_pic_pico :: {-# UNPACK #-} !Int64 -- ^ picosecinds@@ -544,14 +557,22 @@ foreign import ccall "gettimeofday" getTimeOfDay :: Ptr TimeOfDay -> Ptr () -> IO CInt --- | Creates a Unix date.+-- | Create a Unix date.+--+-- > >>> createUnixDate 2013 11 03+-- > 2013-11-03+-- createUnixDate :: Year -> Month -> Day -> UnixDate createUnixDate year month day = if minBound <= date && date <= maxBound then date else error "createUnixDate: date not supported" where date = fromIntegral $ epochToDate year month day --- | Creates a Unix date and time.+-- | Create a Unix date and time.+--+-- > >>> createUnixDateTime 2013 11 03 22 58 29+-- > 2013-11-03 22:58:29+-- createUnixDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> UnixDateTime createUnixDateTime year month day hour minute second = if minBound <= time && time <= maxBound then time@@ -560,7 +581,11 @@ secs = dateToTime hour minute second time = fromIntegral days * 86400 + fromIntegral secs --- | Creates a Unix date and time with millisecond granularity.+-- | Create a Unix date and time with millisecond granularity.+--+-- > >>> createUnixDateTimeMillis 2013 11 03 22 59 13 922+-- > 2013-11-03 22:59:13.922+-- createUnixDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> UnixDateTimeMillis createUnixDateTimeMillis year month day hour minute second millisecond = if minBound <= time && time <= maxBound then time@@ -572,7 +597,11 @@ base = days * 86400 + secs + adds time = UnixDateTimeMillis base mils --- | Creates a Unix date and time with microsecond granularity.+-- | Create a Unix date and time with microsecond granularity.+--+-- > >>> createUnixDateTimeMicros 2013 11 03 23 00 13 573166+-- > 2013-11-03 23:00:13.573166+-- createUnixDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> UnixDateTimeMicros createUnixDateTimeMicros year month day hour minute second microsecond = if minBound <= time && time <= maxBound then time@@ -584,7 +613,11 @@ base = days * 86400 + secs + adds time = UnixDateTimeMicros base mics --- | Creates a Unix date and time with nanosecond granularity.+-- | Create a Unix date and time with nanosecond granularity.+--+-- > >>> createUnixDateTimeNanos 2013 11 03 23 01 43 946387023+-- > 2013-11-03 23:01:43.946387023+-- createUnixDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> UnixDateTimeNanos createUnixDateTimeNanos year month day hour minute second nanosecond = if minBound <= time && time <= maxBound then time@@ -596,7 +629,11 @@ base = days * 86400 + secs + adds time = UnixDateTimeNanos base nans --- | Creates a Unix date and time with picosecond granularity.+-- | Create a Unix date and time with picosecond granularity.+--+-- > >>> createUnixDateTimePicos 2013 11 03 23 04 35 816235224967+-- > 2013-11-03 23:04:35.816235224967+-- createUnixDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> UnixDateTimePicos createUnixDateTimePicos year month day hour minute second picosecond = if minBound <= time && time <= maxBound then time@@ -608,7 +645,7 @@ base = days * 86400 + secs + adds time = UnixDateTimePicos base pics --- | Decomposes a Unix date into a human-readable format.+-- | Decompose a Unix date into a human-readable format. decompUnixDate :: UnixDate -> DateStruct decompUnixDate date = go 1970 $ fromIntegral date@@ -622,7 +659,7 @@ size = if leap then 366 else 365 (,) month mday = decompYearToDate days leap --- | Decomposes the number of days since January 1st into month and day components.+-- | Decompose the number of days since January 1st into month and day components. decompYearToDate :: Day -> Bool -> (Month, Day) decompYearToDate days leap = if leap@@ -673,7 +710,7 @@ then (02, days - 030) else (01, days + 001) --- | Computes the day of the week.+-- | Compute the day of the week from the given Unix date. dayOfWeek :: UnixDate -> DayOfWeek dayOfWeek date = case date `mod` 7 of@@ -685,7 +722,7 @@ 5 -> Tuesday _ -> Wednesday --- | Decomposes a Unix date and time into a human-readable format.+-- | Decompose a Unix date and time into a human-readable format. decompUnixDateTime :: UnixDateTime -> DateTimeStruct decompUnixDateTime time = DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min sec@@ -697,7 +734,7 @@ min = mod2 `div` 00060 sec = fromIntegral $ mod2 `mod` 00060 --- | Decomposes a Unix date and time with millisecond granularity into a human-readable format.+-- | Decompose a Unix date and time with millisecond granularity into a human-readable format. decompUnixDateTimeMillis :: UnixDateTimeMillis -> DateTimeStruct decompUnixDateTimeMillis UnixDateTimeMillis{..} = DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac@@ -711,7 +748,7 @@ time = _uni_mil_base frac = fromIntegral _uni_mil_mill / 1000 --- | Decomposes a Unix date and time with microsecond granularity into a human-readable format.+-- | Decompose a Unix date and time with microsecond granularity into a human-readable format. decompUnixDateTimeMicros :: UnixDateTimeMicros -> DateTimeStruct decompUnixDateTimeMicros UnixDateTimeMicros{..} = DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac@@ -725,7 +762,7 @@ time = _uni_mic_base frac = fromIntegral _uni_mic_micr / 1000000 --- | Decomposes a Unix date and time with nanosecond granularity into a human-readable format.+-- | Decompose a Unix date and time with nanosecond granularity into a human-readable format. decompUnixDateTimeNanos :: UnixDateTimeNanos -> DateTimeStruct decompUnixDateTimeNanos UnixDateTimeNanos{..} = DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac@@ -739,7 +776,7 @@ base = _uni_nan_base frac = fromIntegral _uni_nan_nano / 1000000000 --- | Decomposes a Unix date and time with picosecond granularity into a human-readable format.+-- | Decompose a Unix date and time with picosecond granularity into a human-readable format. decompUnixDateTimePicos :: UnixDateTimePicos -> DateTimeStruct decompUnixDateTimePicos UnixDateTimePicos{..} = DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac@@ -753,11 +790,19 @@ base = _uni_pic_base frac = fromIntegral _uni_pic_pico / 1000000000000 --- | Gets the current Unix date from the system clock.+-- | Get the current Unix date from the system clock.+--+-- > >>> getCurrentUnixDate+-- > 2013-11-03+-- getCurrentUnixDate :: IO UnixDate getCurrentUnixDate = getCurrentUnixDateTime >>= return . convert --- | Gets the current Unix date and time from the system clock.+-- | Get the current Unix date and time from the system clock.+--+-- > >>> getCurrentUnixDateTime+-- > 2013-11-03 23:09:38+-- getCurrentUnixDateTime :: IO UnixDateTime getCurrentUnixDateTime = with (TimeOfDay 0 0) $ \ ptr ->@@ -765,7 +810,11 @@ where getResult ptr 0 = peek $ castPtr ptr getResult _ _ = error "getCurrentUnixDateTime: unknown" --- | Gets the current Unix date and time with millisecond granularity from the system clock.+-- | Get the current Unix date and time with millisecond granularity from the system clock.+--+-- > >>> getCurrentUnixDateTimeMillis+-- > 2013-11-03 23:09:51.986+-- getCurrentUnixDateTimeMillis :: IO UnixDateTimeMillis getCurrentUnixDateTimeMillis = with (TimeOfDay 0 0) $ \ ptr ->@@ -774,7 +823,11 @@ return $! UnixDateTimeMillis tod_base . fromIntegral $ tod_mic `div` 1000 getResult _ _ = error "getCurrentUnixDateTimeMillis: unknown" --- | Gets the current Unix date and time with microsecond granularity from the system clock.+-- | Get the current Unix date and time with microsecond granularity from the system clock.+--+-- > >>> getCurrentUnixDateTimeMicros+-- > 2013-11-03 23:10:06.498559+-- getCurrentUnixDateTimeMicros :: IO UnixDateTimeMicros getCurrentUnixDateTimeMicros = with (TimeOfDay 0 0) $ \ ptr ->@@ -783,7 +836,13 @@ return $! UnixDateTimeMicros tod_base $ fromIntegral tod_mic getResult _ _ = error "getCurrentUnixDateTimeMicros: unknown" --- | Gets the current Unix date and time with nanosecond granularity from the system clock.+-- | Get the current Unix date and time with nanosecond granularity from the system clock.+--+-- > >>> getCurrentUnixDateTimeNanos+-- > 2013-11-03 23:10:23.697893000+--+-- Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant+-- timestamp will have nanosecond granularity, but only microsecond resolution. getCurrentUnixDateTimeNanos :: IO UnixDateTimeNanos getCurrentUnixDateTimeNanos = with (TimeOfDay 0 0) $ \ ptr ->@@ -792,7 +851,13 @@ return $! UnixDateTimeNanos tod_base $ fromIntegral tod_mic * 1000 getResult _ _ = error "getCurrentUnixDateTimeNanos: unknown" --- | Gets the current Unix date and time with picosecond granularity from the system clock.+-- | Get the current Unix date and time with picosecond granularity from the system clock.+--+-- > >>> getCurrentUnixDateTimePicos+-- > 2013-11-03 23:10:44.633032000000+--+-- Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant+-- timestamp will have picosecond granularity, but only microsecond resolution. getCurrentUnixDateTimePicos :: IO UnixDateTimePicos getCurrentUnixDateTimePicos = with (TimeOfDay 0 0) $ \ ptr ->@@ -801,7 +866,7 @@ return $! UnixDateTimePicos tod_base $ fromIntegral tod_mic * 1000000 getResult _ _ = error "getCurrentUnixDateTimePicos: unknown" --- | Shows a Unix date as a string.+-- | Show a Unix date as a string. prettyUnixDate :: UnixDate -> String prettyUnixDate date = printf "%s, %s %s, %04d" wday mon mday _d_year@@ -810,7 +875,7 @@ mon = prettyMonth _d_mon mday = prettyDay _d_mday --- | Shows a Unix date and time as a string.+-- | Show a Unix date and time as a string. prettyUnixDateTime :: DateTime dt => dt -> String prettyUnixDateTime time = printf str hour _dt_min ampm wday mon mday _dt_year
src/Data/Time/Exts/Zone.hs view
@@ -11,8 +11,22 @@ {-# OPTIONS -Wall #-} {-# OPTIONS -fno-warn-type-defaults #-} -module Data.Time.Exts.Zone where+module Data.Time.Exts.Zone ( + -- * Locations+ City(..)+ , cities+ , getOlsonFile++ -- * Time Zones+ , TimeZone(..)+ , getOffset++ -- * Abbreviations+ , TimeZoneAbbr(..)++ ) where+ import Control.Arrow (first) import Data.Aeson (FromJSON, ToJSON) import Data.Convertible (Convertible(..))@@ -21,6 +35,7 @@ import GHC.Generics (Generic) import System.Random (Random(..)) +-- | Cities from around the world. data City = Aden -- ^ Yemeni Republic | Amman -- ^ Hashemite Kingdom of Jordan@@ -74,6 +89,7 @@ | Zurich -- ^ Swiss Confederation deriving (Eq,Enum,Generic,Ord,Show,Typeable) +-- | Time zones from around the world. data TimeZone = Afghanistan_Time | Alaska_Daylight_Time@@ -129,9 +145,10 @@ | Yukon_Standard_Time deriving (Eq,Enum,Generic,Show,Typeable) +-- | A time zone abbreviation. data TimeZoneAbbr = TimeZoneAbbr {- abbr_city :: City -- ^ Reference location- , abbr_str :: String -- ^ Time zone abbreviation string+ abbr_city :: City -- ^ reference location+ , abbr_str :: String -- ^ time zone abbreviation string } deriving (Eq,Generic,Typeable) instance Bounded City where@@ -266,7 +283,7 @@ instance FromJSON TimeZoneAbbr instance Ord TimeZone where- compare = comparing offset+ compare = comparing getOffset instance Random City where random = first toEnum . randomR (0, 49)@@ -338,7 +355,7 @@ , Zurich ] --- | Returns the Olson file associated with the given city.+-- | Get the Olson file associated with the given city. getOlsonFile :: City -> FilePath getOlsonFile = \ case Aden -> "/usr/share/zoneinfo/Asia/Aden"@@ -392,9 +409,9 @@ Vienna -> "/usr/share/zoneinfo/Europe/Vienna" Zurich -> "/usr/share/zoneinfo/Europe/Zurich" --- | Returns the offset (in minutes) for the given time zone.-offset :: Num a => TimeZone -> a-offset = \ case+-- | Get the UTC offset (in minutes) for the given time zone.+getOffset :: Num a => TimeZone -> a+getOffset = \ case Afghanistan_Time -> 270 Alaska_Daylight_Time -> -480 Alaska_Hawaii_Daylight_Time -> -540
time-exts.cabal view
@@ -1,5 +1,5 @@ Name: time-exts-Version: 1.0.1+Version: 1.0.2 License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2013, Enzo Haussecker. All rights reserved.