diff --git a/._LICENSE b/._LICENSE deleted file mode 100644 Binary files a/._LICENSE and /dev/null differ diff --git a/src/Data/Time/Exts/Base.hs b/src/Data/Time/Exts/Base.hs --- a/src/Data/Time/Exts/Base.hs +++ b/src/Data/Time/Exts/Base.hs @@ -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) diff --git a/src/Data/Time/Exts/C.hsc b/src/Data/Time/Exts/C.hsc --- a/src/Data/Time/Exts/C.hsc +++ b/src/Data/Time/Exts/C.hsc @@ -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 diff --git a/src/Data/Time/Exts/Local.hs b/src/Data/Time/Exts/Local.hs --- a/src/Data/Time/Exts/Local.hs +++ b/src/Data/Time/Exts/Local.hs @@ -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) diff --git a/src/Data/Time/Exts/Unix.hs b/src/Data/Time/Exts/Unix.hs --- a/src/Data/Time/Exts/Unix.hs +++ b/src/Data/Time/Exts/Unix.hs @@ -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 diff --git a/src/Data/Time/Exts/Zone.hs b/src/Data/Time/Exts/Zone.hs --- a/src/Data/Time/Exts/Zone.hs +++ b/src/Data/Time/Exts/Zone.hs @@ -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 diff --git a/time-exts.cabal b/time-exts.cabal --- a/time-exts.cabal +++ b/time-exts.cabal @@ -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.