License | BSD-style |
---|---|
Maintainer | Vincent Hanquez <vincent@snarc.org> |
Stability | experimental |
Portability | unknown |
Safe Haskell | None |
Language | Haskell2010 |
Types and methods for time manipulation.
The most basic type for time representation is Elapsed, which represent a number of elapsed seconds since the unix epoch.
Every other defined types can be convert to and from Elapsed type:
timeGetElapsed (Date 1 2 3) :: Elapsed timeFromElapsed 123 :: DateTime
Local time is represented by any other time types (Elapsed, Date, DateTime, ..), but augmented by a Timezone offset in minutes.
localTime (Date 2014 May 4) 600 -- local time at UTC+10 of May 4th 2014
Synopsis
- class Timeable t => Time t where
- class Timeable t where
- newtype Elapsed = Elapsed Seconds
- data ElapsedP = ElapsedP !Elapsed !NanoSeconds
- timeConvert :: (Timeable t1, Time t2) => t1 -> t2
- timeGetDate :: Timeable t => t -> Date
- timeGetDateTimeOfDay :: Timeable t => t -> DateTime
- timeGetTimeOfDay :: Timeable t => t -> TimeOfDay
- data Duration = Duration {}
- data Period = Period {
- periodYears :: !Int
- periodMonths :: !Int
- periodDays :: !Int
- class TimeInterval i where
- timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t
- timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds
- timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds)
- dateAddPeriod :: Date -> Period -> Date
- module Data.Hourglass.Types
- data TimeFormatElem
- = Format_Year2
- | Format_Year4
- | Format_Year
- | Format_Month
- | Format_Month2
- | Format_MonthName_Short
- | Format_DayYear
- | Format_Day
- | Format_Day2
- | Format_Hour
- | Format_Minute
- | Format_Second
- | Format_UnixSecond
- | Format_MilliSecond
- | Format_MicroSecond
- | Format_NanoSecond
- | Format_Precision Int
- | Format_TimezoneName
- | Format_TzHM_Colon_Z
- | Format_TzHM_Colon
- | Format_TzHM
- | Format_Tz_Offset
- | Format_Spaces
- | Format_Text Char
- | Format_Fct TimeFormatFct
- data TimeFormatFct = TimeFormatFct {
- timeFormatFctName :: String
- timeFormatParse :: DateTime -> String -> Either String (DateTime, String)
- timeFormatPrint :: DateTime -> String
- newtype TimeFormatString = TimeFormatString [TimeFormatElem]
- class TimeFormat format where
- data ISO8601_Date = ISO8601_Date
- data ISO8601_DateAndTime = ISO8601_DateAndTime
- timePrint :: (TimeFormat format, Timeable t) => format -> t -> String
- timeParse :: TimeFormat format => format -> String -> Maybe DateTime
- timeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (DateTime, String)
- localTimePrint :: (TimeFormat format, Timeable t) => format -> LocalTime t -> String
- localTimeParse :: TimeFormat format => format -> String -> Maybe (LocalTime DateTime)
- localTimeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (LocalTime DateTime, String)
- data LocalTime t
- localTime :: Time t => TimezoneOffset -> t -> LocalTime t
- localTimeUnwrap :: LocalTime t -> t
- localTimeToGlobal :: Time t => LocalTime t -> t
- localTimeFromGlobal :: Time t => t -> LocalTime t
- localTimeGetTimezone :: LocalTime t -> TimezoneOffset
- localTimeSetTimezone :: Time t => TimezoneOffset -> LocalTime t -> LocalTime t
- localTimeConvert :: (Time t1, Time t2) => LocalTime t1 -> LocalTime t2
- class Timezone tz where
- data UTC = UTC
- newtype TimezoneMinutes = TimezoneMinutes Int
- isLeapYear :: Int -> Bool
- getWeekDay :: Date -> WeekDay
- getDayOfTheYear :: Date -> Int
- daysInMonth :: Int -> Month -> Int
Generic time classes
class Timeable t => Time t where Source #
Represent time types that can be created from other time types.
Every conversion happens throught ElapsedP or Elapsed types.
timeFromElapsedP :: ElapsedP -> t Source #
convert from a number of elapsed seconds and nanoseconds to another time representation
timeFromElapsed :: Elapsed -> t Source #
convert from a number of elapsed seconds and nanoseconds to another time representation
defaults to timeFromElapsedP unless defined explicitely by an instance.
Instances
class Timeable t where Source #
Timeable represent every type that can be made to look like time types.
- can be converted to ElapsedP and Elapsed
- optionally have a timezone associated
- have nanoseconds accessor (which can return 0 when the type is not more precise than seconds)
timeGetElapsedP :: t -> ElapsedP Source #
convert a time representation to the number of elapsed seconds and nanoseconds to a specific epoch
timeGetElapsed :: t -> Elapsed Source #
convert a time representation to the number of elapsed seconds to a specific epoch.
defaults to timeGetElapsedP unless defined explicitely by an instance
timeGetNanoSeconds :: t -> NanoSeconds Source #
return the number of optional nanoseconds.
If the underlaying type is not precise enough to record nanoseconds (or any variant between seconds and nanoseconds), 0 should be returned
defaults to timeGetElapsedP
unless defined explicitely by an instance,
for efficiency reason, it's a good idea to override this methods if
you know the type is not more precise than Seconds.
Instances
Elapsed time
A number of seconds elapsed since the unix epoch.
Instances
Eq Elapsed Source # | |
Data Elapsed Source # | |
Defined in Time.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Elapsed -> c Elapsed # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Elapsed # toConstr :: Elapsed -> Constr # dataTypeOf :: Elapsed -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Elapsed) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Elapsed) # gmapT :: (forall b. Data b => b -> b) -> Elapsed -> Elapsed # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Elapsed -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Elapsed -> r # gmapQ :: (forall d. Data d => d -> u) -> Elapsed -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Elapsed -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Elapsed -> m Elapsed # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Elapsed -> m Elapsed # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Elapsed -> m Elapsed # | |
Num Elapsed Source # | |
Ord Elapsed Source # | |
Read Elapsed Source # | |
Show Elapsed Source # | |
NFData Elapsed Source # | |
Defined in Time.Types | |
Time Elapsed Source # | |
Defined in Data.Hourglass.Time timeFromElapsedP :: ElapsedP -> Elapsed Source # timeFromElapsed :: Elapsed -> Elapsed Source # | |
Timeable Elapsed Source # | |
Defined in Data.Hourglass.Time timeGetElapsedP :: Elapsed -> ElapsedP Source # timeGetElapsed :: Elapsed -> Elapsed Source # |
A number of seconds and nanoseconds elapsed since the unix epoch.
Instances
Generic conversion
timeConvert :: (Timeable t1, Time t2) => t1 -> t2 Source #
Convert one time representation into another one
The return type need to be infer by the context.
If the context cannot be infer through this, some specialized functions are available for built-in types:
Date and Time
timeGetDate :: Timeable t => t -> Date Source #
Get the calendar Date (year-month-day) from a time representation
specialization of timeConvert
timeGetDateTimeOfDay :: Timeable t => t -> DateTime Source #
Get the date and time of day from a time representation
specialization of timeConvert
timeGetTimeOfDay :: Timeable t => t -> TimeOfDay Source #
Get the day time (hours:minutes:seconds) from a time representation
specialization of timeConvert
Arithmetic
An amount of time in terms of constant value like hours (3600 seconds), minutes (60 seconds), seconds and nanoseconds.
Duration | |
|
Instances
Eq Duration Source # | |
Data Duration Source # | |
Defined in Data.Hourglass.Diff gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Duration -> c Duration # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Duration # toConstr :: Duration -> Constr # dataTypeOf :: Duration -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Duration) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration) # gmapT :: (forall b. Data b => b -> b) -> Duration -> Duration # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Duration -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Duration -> r # gmapQ :: (forall d. Data d => d -> u) -> Duration -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Duration -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Duration -> m Duration # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Duration -> m Duration # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Duration -> m Duration # | |
Ord Duration Source # | |
Defined in Data.Hourglass.Diff | |
Read Duration Source # | |
Show Duration Source # | |
Semigroup Duration Source # | |
Monoid Duration Source # | |
NFData Duration Source # | |
Defined in Data.Hourglass.Diff | |
TimeInterval Duration Source # | |
An amount of conceptual calendar time in terms of years, months and days.
This allow calendar manipulation, representing things like days and months irrespective on how long those are related to timezone and daylight changes.
See Duration
for the time-based equivalent to this class.
Period | |
|
Instances
Eq Period Source # | |
Data Period Source # | |
Defined in Data.Hourglass.Diff gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Period -> c Period # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Period # toConstr :: Period -> Constr # dataTypeOf :: Period -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Period) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Period) # gmapT :: (forall b. Data b => b -> b) -> Period -> Period # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r # gmapQ :: (forall d. Data d => d -> u) -> Period -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Period -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Period -> m Period # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Period -> m Period # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Period -> m Period # | |
Ord Period Source # | |
Read Period Source # | |
Show Period Source # | |
Semigroup Period Source # | |
Monoid Period Source # | |
NFData Period Source # | |
Defined in Data.Hourglass.Diff |
class TimeInterval i where Source #
Represent any time interval that has an equivalent value to a number of seconds.
Instances
TimeInterval Hours Source # | |
TimeInterval Minutes Source # | |
TimeInterval Seconds Source # | |
TimeInterval NanoSeconds Source # | |
Defined in Time.Types toSeconds :: NanoSeconds -> Seconds Source # fromSeconds :: Seconds -> (NanoSeconds, Seconds) Source # | |
TimeInterval Duration Source # | |
timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t Source #
add some time interval to a time representation and returns this new time representation
example:
t1 `timeAdd` mempty { durationHours = 12 }
timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds Source #
Get the difference in seconds between two time representation
effectively:
t2 `timeDiff` t1 = t2 - t1
timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds) Source #
Get the difference in seconds and nanoseconds between two time representation
effectively:
@t2 `timeDiffP` t1 = t2 - t1
module Data.Hourglass.Types
Parsing and Printing
Format strings
data TimeFormatElem Source #
All the various formatter that can be part of a time format string
Format_Year2 | 2 digit years (70 is 1970, 69 is 2069) |
Format_Year4 | 4 digits years |
Format_Year | any digits years |
Format_Month | months (1 to 12) |
Format_Month2 | months padded to 2 chars (01 to 12) |
Format_MonthName_Short | name of the month short ( |
Format_DayYear | day of the year (1 to 365, 366 for leap years) |
Format_Day | day of the month (1 to 31) |
Format_Day2 | day of the month (01 to 31) |
Format_Hour | hours (0 to 23) |
Format_Minute | minutes (0 to 59) |
Format_Second | seconds (0 to 59, 60 for leap seconds) |
Format_UnixSecond | number of seconds since 1 jan 1970. unix epoch. |
Format_MilliSecond | Milliseconds (000 to 999) |
Format_MicroSecond | MicroSeconds (000000 to 999999) |
Format_NanoSecond | NanoSeconds (000000000 to 999999999) |
Format_Precision Int | sub seconds display with a precision of N digits. with N between 1 and 9 |
Format_TimezoneName | timezone name (e.g. GMT, PST). not implemented yet | Format_TimezoneOffset -- ^ timeoffset offset (+02:00) |
Format_TzHM_Colon_Z | zero UTC offset (Z) or timeoffset with colon (+02:00) |
Format_TzHM_Colon | timeoffset offset with colon (+02:00) |
Format_TzHM | timeoffset offset (+0200) |
Format_Tz_Offset | timeoffset in minutes |
Format_Spaces | one or many space-like chars |
Format_Text Char | a verbatim char |
Format_Fct TimeFormatFct |
Instances
Eq TimeFormatElem Source # | |
Defined in Data.Hourglass.Format (==) :: TimeFormatElem -> TimeFormatElem -> Bool # (/=) :: TimeFormatElem -> TimeFormatElem -> Bool # | |
Show TimeFormatElem Source # | |
Defined in Data.Hourglass.Format showsPrec :: Int -> TimeFormatElem -> ShowS # show :: TimeFormatElem -> String # showList :: [TimeFormatElem] -> ShowS # | |
TimeFormat [TimeFormatElem] Source # | |
Defined in Data.Hourglass.Format toFormat :: [TimeFormatElem] -> TimeFormatString Source # |
data TimeFormatFct Source #
A generic format function composed of a parser and a printer.
TimeFormatFct | |
|
Instances
Eq TimeFormatFct Source # | |
Defined in Data.Hourglass.Format (==) :: TimeFormatFct -> TimeFormatFct -> Bool # (/=) :: TimeFormatFct -> TimeFormatFct -> Bool # | |
Show TimeFormatFct Source # | |
Defined in Data.Hourglass.Format showsPrec :: Int -> TimeFormatFct -> ShowS # show :: TimeFormatFct -> String # showList :: [TimeFormatFct] -> ShowS # |
newtype TimeFormatString Source #
A time format string, composed of list of TimeFormatElem
Instances
Eq TimeFormatString Source # | |
Defined in Data.Hourglass.Format (==) :: TimeFormatString -> TimeFormatString -> Bool # (/=) :: TimeFormatString -> TimeFormatString -> Bool # | |
Show TimeFormatString Source # | |
Defined in Data.Hourglass.Format showsPrec :: Int -> TimeFormatString -> ShowS # show :: TimeFormatString -> String # showList :: [TimeFormatString] -> ShowS # | |
TimeFormat TimeFormatString Source # | |
Defined in Data.Hourglass.Format |
class TimeFormat format where Source #
A generic class for anything that can be considered a Time Format string.
toFormat :: format -> TimeFormatString Source #
Instances
TimeFormat String Source # | |
Defined in Data.Hourglass.Format toFormat :: String -> TimeFormatString Source # | |
TimeFormat ISO8601_DateAndTime Source # | |
Defined in Data.Hourglass.Format | |
TimeFormat ISO8601_Date Source # | |
Defined in Data.Hourglass.Format | |
TimeFormat TimeFormatString Source # | |
Defined in Data.Hourglass.Format | |
TimeFormat [TimeFormatElem] Source # | |
Defined in Data.Hourglass.Format toFormat :: [TimeFormatElem] -> TimeFormatString Source # |
Common built-in formats
data ISO8601_Date Source #
ISO8601 Date format string.
e.g. 2014-04-05
Instances
Eq ISO8601_Date Source # | |
Defined in Data.Hourglass.Format (==) :: ISO8601_Date -> ISO8601_Date -> Bool # (/=) :: ISO8601_Date -> ISO8601_Date -> Bool # | |
Show ISO8601_Date Source # | |
Defined in Data.Hourglass.Format showsPrec :: Int -> ISO8601_Date -> ShowS # show :: ISO8601_Date -> String # showList :: [ISO8601_Date] -> ShowS # | |
TimeFormat ISO8601_Date Source # | |
Defined in Data.Hourglass.Format |
data ISO8601_DateAndTime Source #
ISO8601 Date and Time format string.
e.g. 2014-04-05T17:25:04+00:00 2014-04-05T17:25:04Z
Instances
Eq ISO8601_DateAndTime Source # | |
Defined in Data.Hourglass.Format (==) :: ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool # (/=) :: ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool # | |
Show ISO8601_DateAndTime Source # | |
Defined in Data.Hourglass.Format showsPrec :: Int -> ISO8601_DateAndTime -> ShowS # show :: ISO8601_DateAndTime -> String # showList :: [ISO8601_DateAndTime] -> ShowS # | |
TimeFormat ISO8601_DateAndTime Source # | |
Defined in Data.Hourglass.Format |
Format methods
:: (TimeFormat format, Timeable t) | |
=> format | the format to use for printing |
-> t | the global time to print |
-> String | the resulting string |
Pretty print time to a string
The actual output is determined by the format used
timeParse :: TimeFormat format => format -> String -> Maybe DateTime Source #
Just like localTimeParse
but the time is automatically converted to global time.
timeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (DateTime, String) Source #
like localTimeParseE
but the time value is automatically converted to global time.
:: (TimeFormat format, Timeable t) | |
=> format | the format to use for printing |
-> LocalTime t | the local time to print |
-> String | the resulting local time string |
Pretty print local time to a string.
The actual output is determined by the format used.
:: TimeFormat format | |
=> format | the format to use for parsing |
-> String | the string to parse |
-> Maybe (LocalTime DateTime) |
Try parsing a string as time using the format explicitely specified
Unparsed characters are ignored and the error handling is simplified
for more elaborate need use localTimeParseE
.
:: TimeFormat format | |
=> format | the format to use for parsing |
-> String | the string to parse |
-> Either (TimeFormatElem, String) (LocalTime DateTime, String) |
Try parsing a string as time using the format explicitely specified
On failure, the parsing function returns the reason of the failure. If parsing is successful, return the date parsed with the remaining unparsed string
Local time
Local time type
Local time representation
this is a time representation augmented by a timezone to get back to a global time, the timezoneOffset needed to be added to the local time.
Instances
Functor LocalTime Source # | |
Eq t => Eq (LocalTime t) Source # | |
(Ord t, Time t) => Ord (LocalTime t) Source # | |
Defined in Data.Hourglass.Local | |
Show t => Show (LocalTime t) Source # | |
Local time creation and manipulation
localTime :: Time t => TimezoneOffset -> t -> LocalTime t Source #
Create a local time type from a timezone and a time type.
The time value is assumed to be local to the timezone offset set, so no transformation is done.
localTimeUnwrap :: LocalTime t -> t Source #
unwrap the LocalTime value. the time value is local.
localTimeToGlobal :: Time t => LocalTime t -> t Source #
Get back a global time value
localTimeFromGlobal :: Time t => t -> LocalTime t Source #
create a local time value from a global one
localTimeGetTimezone :: LocalTime t -> TimezoneOffset Source #
get the timezone associated with LocalTime
localTimeSetTimezone :: Time t => TimezoneOffset -> LocalTime t -> LocalTime t Source #
Change the timezone, and adjust the local value to represent the new local value.
localTimeConvert :: (Time t1, Time t2) => LocalTime t1 -> LocalTime t2 Source #
convert the local time representation to another time representation determined by context.
class Timezone tz where Source #
standard representation for timezone
timezoneOffset :: tz -> Int Source #
offset in minutes from UTC. valid values should be between -12*60 to +14*60
timezoneName :: tz -> String Source #
the name of the timezone. by default will be +-HH:MM encoding.
Instances
Timezone UTC Source # | |
Defined in Data.Hourglass.Zone timezoneOffset :: UTC -> Int Source # timezoneName :: UTC -> String Source # | |
Timezone TimezoneMinutes Source # | |
Defined in Data.Hourglass.Zone timezoneOffset :: TimezoneMinutes -> Int Source # timezoneName :: TimezoneMinutes -> String Source # |
Universal Time Coordinated. The generic computer "timezone".
newtype TimezoneMinutes Source #
Simple timezone containing the number of minutes difference with UTC.
Valid values should be between -12*60 to +14*60
Instances
Eq TimezoneMinutes Source # | |
Defined in Data.Hourglass.Zone (==) :: TimezoneMinutes -> TimezoneMinutes -> Bool # (/=) :: TimezoneMinutes -> TimezoneMinutes -> Bool # | |
Ord TimezoneMinutes Source # | |
Defined in Data.Hourglass.Zone compare :: TimezoneMinutes -> TimezoneMinutes -> Ordering # (<) :: TimezoneMinutes -> TimezoneMinutes -> Bool # (<=) :: TimezoneMinutes -> TimezoneMinutes -> Bool # (>) :: TimezoneMinutes -> TimezoneMinutes -> Bool # (>=) :: TimezoneMinutes -> TimezoneMinutes -> Bool # max :: TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes # min :: TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes # | |
Show TimezoneMinutes Source # | |
Defined in Data.Hourglass.Zone showsPrec :: Int -> TimezoneMinutes -> ShowS # show :: TimezoneMinutes -> String # showList :: [TimezoneMinutes] -> ShowS # | |
Timezone TimezoneMinutes Source # | |
Defined in Data.Hourglass.Zone timezoneOffset :: TimezoneMinutes -> Int Source # timezoneName :: TimezoneMinutes -> String Source # |
Calendar misc functions
isLeapYear :: Int -> Bool Source #
Return if this year is a leap year (366 days) or not (365 days in a year)
getWeekDay :: Date -> WeekDay Source #
Return the day of the week a specific date fall in
getDayOfTheYear :: Date -> Int Source #
return the day of the year where Jan 1 is 0
between 0 and 364. 365 for leap years