thyme-0.3.5.5: A faster time library

Safe HaskellNone
LanguageHaskell2010

Data.Thyme.Clock

Contents

Description

Types and functions for UTC and UT1.

If you don't care about leap seconds, keep to UTCTime and NominalDiffTime for your clock calculations, and you'll be fine.

Num, Real, Fractional and RealFrac instances for DiffTime and NominalDiffTime are only available by importing Data.Thyme.Time. In their stead are instances of AdditiveGroup, HasBasis and VectorSpace, with Scalar DiffTimeScalar NominalDiffTimeRational.

Using fromSeconds and toSeconds to convert between TimeDiffs and other numeric types. If you really must coerce between DiffTime and NominalDiffTime, view (microseconds . from microseconds).

UTCTime is an instance of AffineSpace, with Diff UTCTimeNominalDiffTime.

UTCTime is not Y294K-compliant. Please file a bug report on GitHub when this becomes a problem.

Synopsis

Universal Time

data UniversalTime #

The principal form of universal time, namely UT1.

UniversalTime is defined by the rotation of the Earth around its axis relative to the Sun. Thus the length of a day by this definition varies from one to the next, and is never exactly 86400 SI seconds unlike TAI or AbsoluteTime. The difference between UT1 and UTC is DUT1.

Instances

Bounded UniversalTime # 
Enum UniversalTime # 
Eq UniversalTime # 
Data UniversalTime # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UniversalTime -> c UniversalTime #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UniversalTime #

toConstr :: UniversalTime -> Constr #

dataTypeOf :: UniversalTime -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c UniversalTime) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UniversalTime) #

gmapT :: (forall b. Data b => b -> b) -> UniversalTime -> UniversalTime #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UniversalTime -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UniversalTime -> r #

gmapQ :: (forall d. Data d => d -> u) -> UniversalTime -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> UniversalTime -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> UniversalTime -> m UniversalTime #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UniversalTime -> m UniversalTime #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UniversalTime -> m UniversalTime #

Ord UniversalTime # 
Ix UniversalTime # 
Generic UniversalTime # 

Associated Types

type Rep UniversalTime :: * -> * #

Arbitrary UniversalTime # 
CoArbitrary UniversalTime # 

Methods

coarbitrary :: UniversalTime -> Gen b -> Gen b #

NFData UniversalTime # 

Methods

rnf :: UniversalTime -> () #

Random UniversalTime # 
Unbox UniversalTime # 
ParseTime UniversalTime # 
FormatTime UniversalTime # 

Methods

showsTime :: TimeLocale -> UniversalTime -> (Char -> ShowS) -> Char -> ShowS #

Vector Vector UniversalTime # 
MVector MVector UniversalTime # 
Thyme UniversalTime UniversalTime # 
type Rep UniversalTime # 
type Rep UniversalTime = D1 (MetaData "UniversalTime" "Data.Thyme.Clock.Internal" "thyme-0.3.5.5-Euo2CSV7iPYDvUTkZvcOvB" True) (C1 (MetaCons "UniversalRep" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 NominalDiffTime)))
data Vector UniversalTime # 
data MVector s UniversalTime # 

modJulianDate :: Iso' UniversalTime Rational #

View UniversalTime as a fractional number of days since the Modified Julian Date epoch.

Absolute intervals

data DiffTime #

An absolute time interval as measured by a clock.

DiffTime forms an AdditiveGroup―so can be added using ^+^ (or ^-^ for subtraction), and also an instance of VectorSpace―so can be scaled using *^, where

type Scalar DiffTime = Rational

Instances

Bounded DiffTime # 
Enum DiffTime # 
Eq DiffTime # 
Data DiffTime # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DiffTime -> c DiffTime #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DiffTime #

toConstr :: DiffTime -> Constr #

dataTypeOf :: DiffTime -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c DiffTime) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DiffTime) #

gmapT :: (forall b. Data b => b -> b) -> DiffTime -> DiffTime #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DiffTime -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DiffTime -> r #

gmapQ :: (forall d. Data d => d -> u) -> DiffTime -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DiffTime -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DiffTime -> m DiffTime #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DiffTime -> m DiffTime #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DiffTime -> m DiffTime #

Ord DiffTime # 
Read DiffTime # 
Show DiffTime # 
Ix DiffTime # 
Generic DiffTime # 

Associated Types

type Rep DiffTime :: * -> * #

Methods

from :: DiffTime -> Rep DiffTime x #

to :: Rep DiffTime x -> DiffTime #

Arbitrary DiffTime # 
CoArbitrary DiffTime # 

Methods

coarbitrary :: DiffTime -> Gen b -> Gen b #

NFData DiffTime # 

Methods

rnf :: DiffTime -> () #

Random DiffTime # 
Unbox DiffTime # 
HasBasis DiffTime # 
VectorSpace DiffTime # 

Associated Types

type Scalar DiffTime :: * #

AdditiveGroup DiffTime # 
TimeDiff DiffTime # 

Methods

microseconds :: Iso' DiffTime Int64 #

Vector Vector DiffTime # 
MVector MVector DiffTime # 
Thyme DiffTime DiffTime # 

Methods

thyme :: Iso' DiffTime DiffTime #

type Rep DiffTime # 
type Rep DiffTime = D1 (MetaData "DiffTime" "Data.Thyme.Clock.Internal" "thyme-0.3.5.5-Euo2CSV7iPYDvUTkZvcOvB" True) (C1 (MetaCons "DiffTime" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Micro)))
data Vector DiffTime # 
type Basis DiffTime # 
type Basis DiffTime = ()
type Scalar DiffTime # 
data MVector s DiffTime # 

UTC

data UTCTime #

Coördinated universal time: the most common form of universal time for civil timekeeping. It is synchronised with AbsoluteTime and both tick in increments of SI seconds, but UTC includes occasional leap-seconds so that it does not drift too far from UniversalTime.

UTCTime is an instance of AffineSpace, with

type Diff UTCTime = NominalDiffTime

Use .+^ to add (or .-^ to subtract) time intervals of type NominalDiffTime, and .-. to get the interval between UTCTimes.

Performance
Internally this is a 64-bit count of microseconds since the MJD epoch, so .+^, .-^ and .-. ought to be fairly fast.
Issues
UTCTime currently cannot represent leap seconds.

Instances

Bounded UTCTime # 
Enum UTCTime # 
Eq UTCTime # 

Methods

(==) :: UTCTime -> UTCTime -> Bool #

(/=) :: UTCTime -> UTCTime -> Bool #

Data UTCTime # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UTCTime -> c UTCTime #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UTCTime #

toConstr :: UTCTime -> Constr #

dataTypeOf :: UTCTime -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c UTCTime) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UTCTime) #

gmapT :: (forall b. Data b => b -> b) -> UTCTime -> UTCTime #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UTCTime -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UTCTime -> r #

gmapQ :: (forall d. Data d => d -> u) -> UTCTime -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> UTCTime -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> UTCTime -> m UTCTime #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UTCTime -> m UTCTime #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UTCTime -> m UTCTime #

Ord UTCTime # 
Ix UTCTime # 
Generic UTCTime # 

Associated Types

type Rep UTCTime :: * -> * #

Methods

from :: UTCTime -> Rep UTCTime x #

to :: Rep UTCTime x -> UTCTime #

Arbitrary UTCTime # 
CoArbitrary UTCTime # 

Methods

coarbitrary :: UTCTime -> Gen b -> Gen b #

NFData UTCTime # 

Methods

rnf :: UTCTime -> () #

Random UTCTime # 

Methods

randomR :: RandomGen g => (UTCTime, UTCTime) -> g -> (UTCTime, g) #

random :: RandomGen g => g -> (UTCTime, g) #

randomRs :: RandomGen g => (UTCTime, UTCTime) -> g -> [UTCTime] #

randoms :: RandomGen g => g -> [UTCTime] #

randomRIO :: (UTCTime, UTCTime) -> IO UTCTime #

randomIO :: IO UTCTime #

Unbox UTCTime # 
AffineSpace UTCTime # 

Associated Types

type Diff UTCTime :: * #

ParseTime UTCTime # 
FormatTime UTCTime # 

Methods

showsTime :: TimeLocale -> UTCTime -> (Char -> ShowS) -> Char -> ShowS #

Vector Vector UTCTime # 
MVector MVector UTCTime # 
Thyme UTCTime UTCTime # 

Methods

thyme :: Iso' UTCTime UTCTime #

type Rep UTCTime # 
type Rep UTCTime = D1 (MetaData "UTCTime" "Data.Thyme.Clock.Internal" "thyme-0.3.5.5-Euo2CSV7iPYDvUTkZvcOvB" True) (C1 (MetaCons "UTCRep" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 NominalDiffTime)))
data Vector UTCTime # 
type Diff UTCTime # 
data MVector s UTCTime # 

data UTCView #

Unpacked UTCTime, partly for compatibility with time.

Constructors

UTCTime 

Fields

Instances

Eq UTCView # 

Methods

(==) :: UTCView -> UTCView -> Bool #

(/=) :: UTCView -> UTCView -> Bool #

Data UTCView # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UTCView -> c UTCView #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UTCView #

toConstr :: UTCView -> Constr #

dataTypeOf :: UTCView -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c UTCView) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UTCView) #

gmapT :: (forall b. Data b => b -> b) -> UTCView -> UTCView #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UTCView -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UTCView -> r #

gmapQ :: (forall d. Data d => d -> u) -> UTCView -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> UTCView -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> UTCView -> m UTCView #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UTCView -> m UTCView #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UTCView -> m UTCView #

Ord UTCView # 
Show UTCView # 
Generic UTCView # 

Associated Types

type Rep UTCView :: * -> * #

Methods

from :: UTCView -> Rep UTCView x #

to :: Rep UTCView x -> UTCView #

NFData UTCView # 

Methods

rnf :: UTCView -> () #

Unbox UTCView # 
Vector Vector UTCView # 
MVector MVector UTCView # 
Thyme UTCTime UTCView # 

Methods

thyme :: Iso' UTCTime UTCView #

type Rep UTCView # 
type Rep UTCView = D1 (MetaData "UTCView" "Data.Thyme.Clock.Internal" "thyme-0.3.5.5-Euo2CSV7iPYDvUTkZvcOvB" False) (C1 (MetaCons "UTCTime" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "utctDay") SourceUnpack SourceStrict DecidedUnpack) (Rec0 Day)) (S1 (MetaSel (Just Symbol "utctDayTime") SourceUnpack SourceStrict DecidedUnpack) (Rec0 DiffTime))))
data Vector UTCView # 
data MVector s UTCView # 

utcTime :: Iso' UTCTime UTCView #

View UTCTime as an UTCView, comprising a Day along with a DiffTime offset since midnight.

This is an improper lens: utctDayTime offsets outside the range of [zeroV, posixDayLength) will carry over into the day part, with the expected behaviour.

data NominalDiffTime #

A time interval as measured by UTC, that does not take leap-seconds into account.

For instance, the difference between 23:59:59 and 00:00:01 on the following day is always 2 seconds of NominalDiffTime, regardless of whether a leap-second took place.

NominalDiffTime forms an AdditiveGroup―so can be added using ^+^ (or ^-^ for subtraction), and also an instance of VectorSpace―so can be scaled using *^, where

type Scalar NominalDiffTime = Rational

Instances

Bounded NominalDiffTime # 
Enum NominalDiffTime # 
Eq NominalDiffTime # 
Data NominalDiffTime # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> NominalDiffTime -> c NominalDiffTime #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c NominalDiffTime #

toConstr :: NominalDiffTime -> Constr #

dataTypeOf :: NominalDiffTime -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c NominalDiffTime) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NominalDiffTime) #

gmapT :: (forall b. Data b => b -> b) -> NominalDiffTime -> NominalDiffTime #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NominalDiffTime -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NominalDiffTime -> r #

gmapQ :: (forall d. Data d => d -> u) -> NominalDiffTime -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> NominalDiffTime -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> NominalDiffTime -> m NominalDiffTime #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> NominalDiffTime -> m NominalDiffTime #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> NominalDiffTime -> m NominalDiffTime #

Ord NominalDiffTime # 
Read NominalDiffTime # 
Show NominalDiffTime # 
Ix NominalDiffTime # 
Generic NominalDiffTime # 
Arbitrary NominalDiffTime # 
CoArbitrary NominalDiffTime # 

Methods

coarbitrary :: NominalDiffTime -> Gen b -> Gen b #

NFData NominalDiffTime # 

Methods

rnf :: NominalDiffTime -> () #

Random NominalDiffTime # 
Unbox NominalDiffTime # 
HasBasis NominalDiffTime # 
VectorSpace NominalDiffTime # 
AdditiveGroup NominalDiffTime # 
TimeDiff NominalDiffTime # 
Vector Vector NominalDiffTime # 
MVector MVector NominalDiffTime # 
Thyme NominalDiffTime NominalDiffTime # 
type Rep NominalDiffTime # 
type Rep NominalDiffTime = D1 (MetaData "NominalDiffTime" "Data.Thyme.Clock.Internal" "thyme-0.3.5.5-Euo2CSV7iPYDvUTkZvcOvB" True) (C1 (MetaCons "NominalDiffTime" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Micro)))
data Vector NominalDiffTime # 
type Basis NominalDiffTime # 
type Scalar NominalDiffTime # 
data MVector s NominalDiffTime # 

getCurrentTime :: IO UTCTime #

Get the current UTC time from the system clock.

Time interval conversion

class (HasBasis t, Basis t ~ (), Scalar t ~ Rational) => TimeDiff t where #

Time intervals, encompassing both DiffTime and NominalDiffTime.

Issues
Still affected by http://hackage.haskell.org/trac/ghc/ticket/7611?

Minimal complete definition

microseconds

Methods

microseconds :: Iso' t Int64 #

Escape hatch; avoid.

toSeconds :: (TimeDiff t, Fractional n) => t -> n #

Convert a time interval to some Fractional type.

fromSeconds :: (Real n, TimeDiff t) => n -> t #

Make a time interval from some Real type.

Performance
Try to make sure n is one of Float, Double, Int, Int64 or Integer, for which rewrite RULES have been provided.

toSeconds' :: TimeDiff t => t -> Rational #

Type-restricted toSeconds to avoid constraint-defaulting warnings.

fromSeconds' :: TimeDiff t => Rational -> t #

Type-restricted fromSeconds to avoid constraint-defaulting warnings.

Lenses

_utctDay :: Lens' UTCTime Day #

Lens' for the Day component of an UTCTime.

_utctDayTime :: Lens' UTCTime DiffTime #

Lens' for the time-of-day component of an UTCTime.