Copyright | Copyright © 2021 Kadena LLC. |
---|---|
License | MIT |
Maintainer | Lars Kuhtz <lars@kadena.io> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
This is an internal module. No guarantee is provided regarding the stability of the functions in this module. Use at your own risk.
Synopsis
- type Micros = Int64
- type Day = Int
- newtype NominalDiffTime = NominalDiffTime {}
- toMicroseconds :: NominalDiffTime -> Micros
- fromMicroseconds :: Micros -> NominalDiffTime
- toSeconds :: NominalDiffTime -> Decimal
- fromSeconds :: Decimal -> NominalDiffTime
- nominalDay :: NominalDiffTime
- newtype UTCTime = UTCTime {}
- getCurrentTime :: IO UTCTime
- day :: Lens' UTCTime ModifiedJulianDay
- dayTime :: Lens' UTCTime NominalDiffTime
- fromDayAndDayTime :: ModifiedJulianDay -> NominalDiffTime -> UTCTime
- toPosixTimestampMicros :: UTCTime -> Micros
- fromPosixTimestampMicros :: Micros -> UTCTime
- mjdEpoch :: UTCTime
- posixEpoch :: UTCTime
- newtype ModifiedJulianDay = ModifiedJulianDay Day
- data ModifiedJulianDate = ModifiedJulianDate {}
- toModifiedJulianDate :: UTCTime -> ModifiedJulianDate
- fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime
- class AdditiveGroup (Diff p) => AffineSpace p where
- class AdditiveGroup v => VectorSpace v where
Documentation
NominalDiffTime
newtype NominalDiffTime Source #
A time interval as measured by UTC, that does not take leap-seconds into account.
Instances
toMicroseconds :: NominalDiffTime -> Micros Source #
Convert from NominalDiffTime
to a 64-bit representation of microseconds.
fromMicroseconds :: Micros -> NominalDiffTime Source #
Convert from a 64-bit representation of microseconds to NominalDiffTime
.
toSeconds :: NominalDiffTime -> Decimal Source #
Convert from NominalDiffTime
to a Decimal
representation of seconds.
fromSeconds :: Decimal -> NominalDiffTime Source #
Convert from Decimal
representation of seconds to NominalDiffTime
.
The result is rounded using banker's method, i.e. remainders of 0.5 a rounded to the next even integer.
nominalDay :: NominalDiffTime Source #
The nominal length of a day: precisely 86400 SI seconds.
UTCTime
UTCTime with microseconds precision. Internally it is represented as 64-bit count nominal microseconds since MJD Epoch.
This implementation ignores leap seconds. Time differences are measured as
nominal time, with a nominal day having exaxtly 24 * 60 * 60
SI seconds. As
a consequence the difference between two dates as computed by this module is
generally equal or smaller than what is actually measured by a clock.
Instances
Eq UTCTime Source # | |
Ord UTCTime Source # | |
Read UTCTime Source # | |
Show UTCTime Source # | |
Generic UTCTime Source # | |
ToJSON UTCTime Source # | |
Defined in Pact.Time.Format.Internal | |
FromJSON UTCTime Source # | |
Serialize UTCTime Source # | |
NFData UTCTime Source # | |
Defined in Pact.Time.Internal | |
AffineSpace UTCTime Source # | |
type Rep UTCTime Source # | |
Defined in Pact.Time.Internal type Rep UTCTime = D1 ('MetaData "UTCTime" "Pact.Time.Internal" "pact-time-0.2.0.0-3wMwyzgM4Cx3uihv7VMGTk" 'True) (C1 ('MetaCons "UTCTime" 'PrefixI 'True) (S1 ('MetaSel ('Just "_utcTime") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalDiffTime))) | |
type Diff UTCTime Source # | |
Defined in Pact.Time.Internal |
day :: Lens' UTCTime ModifiedJulianDay Source #
The date of a UTCTime value represented as modified Julian Day
.
dayTime :: Lens' UTCTime NominalDiffTime Source #
The day time of a UTCTime
value represented as NominalDiffTime
since
00:00:00
of that respective day.
fromDayAndDayTime :: ModifiedJulianDay -> NominalDiffTime -> UTCTime Source #
Create a UTCTime
from a date and a daytime. The date is represented
as modified Julian Day
and the day time is represented as
NominalDiffTime
since '00:00:00' of the respective day.
Note that this implementation does not support representation of leap seconds.
posixEpoch :: UTCTime Source #
The POSIX Epoch represented as UTCTime.
Julian Dates
newtype ModifiedJulianDay Source #
Instances
Eq ModifiedJulianDay Source # | |
Defined in Pact.Time.Internal (==) :: ModifiedJulianDay -> ModifiedJulianDay -> Bool # (/=) :: ModifiedJulianDay -> ModifiedJulianDay -> Bool # | |
Ord ModifiedJulianDay Source # | |
Defined in Pact.Time.Internal compare :: ModifiedJulianDay -> ModifiedJulianDay -> Ordering # (<) :: ModifiedJulianDay -> ModifiedJulianDay -> Bool # (<=) :: ModifiedJulianDay -> ModifiedJulianDay -> Bool # (>) :: ModifiedJulianDay -> ModifiedJulianDay -> Bool # (>=) :: ModifiedJulianDay -> ModifiedJulianDay -> Bool # max :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay # min :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay # | |
NFData ModifiedJulianDay Source # | |
Defined in Pact.Time.Internal rnf :: ModifiedJulianDay -> () # |
data ModifiedJulianDate Source #
Modified Julian Day Representation of UTC
Instances
toModifiedJulianDate :: UTCTime -> ModifiedJulianDate Source #
Convert from UTCTime
to modified Julian
Day time.
fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime Source #
Convert from modified Julian
Day time to UTCTime
.
Reexports
class AdditiveGroup (Diff p) => AffineSpace p where #
Nothing
(.-.) :: p -> p -> Diff p infix 6 #
Subtract points
(.+^) :: p -> Diff p -> p infixl 6 #
Point plus vector
Instances
AffineSpace Double | |
AffineSpace Float | |
AffineSpace Int | |
AffineSpace Integer | |
AffineSpace CSChar | |
AffineSpace CShort | |
AffineSpace CInt | |
AffineSpace CLong | |
AffineSpace CLLong | |
AffineSpace CFloat | |
AffineSpace CDouble | |
AffineSpace CIntMax | |
AffineSpace UTCTime Source # | |
Integral a => AffineSpace (Ratio a) | |
AffineSpace p => AffineSpace (a -> p) | |
(AffineSpace p, AffineSpace q) => AffineSpace (p, q) | |
AffineSpace a => AffineSpace (Rec0 a s) | |
(AffineSpace p, AffineSpace q, AffineSpace r) => AffineSpace (p, q, r) | |
(AffineSpace (f p), AffineSpace (g p)) => AffineSpace (AffineDiffProductSpace f g p) | |
(AffineSpace (f p), AffineSpace (g p)) => AffineSpace ((f :*: g) p) | |
AffineSpace (f p) => AffineSpace (M1 i c f p) | |
class AdditiveGroup v => VectorSpace v where #
Vector space v
.
Nothing