Safe Haskell | None |
---|---|
Language | Haskell2010 |
Database.PostgreSQL.Simple.Interval.Unstable
Synopsis
- data Interval = MkInterval {}
- zero :: Interval
- fromMicroseconds :: Int64 -> Interval
- fromMilliseconds :: Int64 -> Maybe Interval
- fromMillisecondsSaturating :: Int64 -> Interval
- fromMillisecondsLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 9223372036854775) => proxy n -> Interval
- fromSeconds :: Int64 -> Maybe Interval
- fromSecondsSaturating :: Int64 -> Interval
- fromSecondsLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 9223372036854) => proxy n -> Interval
- fromMinutes :: Int64 -> Maybe Interval
- fromMinutesSaturating :: Int64 -> Interval
- fromMinutesLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 153722867280) => proxy n -> Interval
- fromHours :: Int64 -> Maybe Interval
- fromHoursSaturating :: Int64 -> Interval
- fromHoursLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 2562047788) => proxy n -> Interval
- fromDays :: Int32 -> Interval
- fromWeeks :: Int32 -> Maybe Interval
- fromWeeksSaturating :: Int32 -> Interval
- fromWeeksLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 306783378) => proxy n -> Interval
- fromMonths :: Int32 -> Interval
- fromYears :: Int32 -> Maybe Interval
- fromYearsSaturating :: Int32 -> Interval
- fromYearsLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 178956970) => proxy n -> Interval
- negate :: Interval -> Maybe Interval
- negateSaturating :: Interval -> Interval
- add :: Interval -> Interval -> Maybe Interval
- addSaturating :: Interval -> Interval -> Interval
- intoTime :: Interval -> (CalendarDiffDays, NominalDiffTime)
- fromTime :: CalendarDiffDays -> NominalDiffTime -> Maybe Interval
- fromTimeSaturating :: CalendarDiffDays -> NominalDiffTime -> Interval
- intoMicro :: Integer -> Micro
- fromMicro :: Micro -> Integer
- scale :: Rational -> Interval -> Maybe Interval
- scaleSaturating :: Rational -> Interval -> Interval
- render :: Interval -> Builder
- parse :: Parser Interval
- parseInfinities :: Parser Interval
- parseIso8601 :: Parser [Component]
- parsePostgresVerbose :: Parser [Component]
- parsePostgres :: Parser [Component]
- parseSqlStandard :: Parser [Component]
- parseTime :: Parser [Component]
- parseSign :: Parser ByteString
- maybePlural :: ByteString -> Parser ByteString
- data Component
- fromComponent :: Component -> Maybe Interval
- fromComponents :: (Alternative f, Traversable t) => t Component -> f Interval
- negateComponent :: Component -> Component
- negateComponentsWhen :: Functor f => Bool -> f Component -> f Component
- toIntegralSaturating :: (Integral a, Integral b, Bounded b) => a -> b
Documentation
This type represents a PostgreSQL interval. Intervals can have month, day, and microsecond components. Each component is bounded, so they are not arbitrary precision. For more information about intervals, consult the PostgreSQL documentation: https://www.postgresql.org/docs/17/datatype-datetime.html#DATATYPE-INTERVAL-INPUT.
Note that the time
library provides several duration types that are not
appropriate to use as PostgreSQL intervals:
NominalDiffTime
: Does not handle days or months. Allows up to picosecond precision. Is not bounded.CalendarDiffTime
: Does not handle days. Embeds aNominalDiffTime
. Is not bounded.CalendarDiffDays
: Does not handle seconds. Is not bounded.
WARNING: The PostgreSQL interval parser is broken in versions prior to 15. It is not possible to round trip all intervals through PostgreSQL on those versions. You should upgrade to at least PostgreSQL version 15. For more information, see this patch: https://git.postgresql.org/gitweb/?p=postgresql.git;a=commitdiff;h=e39f99046
Constructors
MkInterval | |
Instances
Show Interval Source # | |
Eq Interval Source # | |
PersistField Interval Source # | |
Defined in Database.PostgreSQL.Simple.Interval.Unstable Methods toPersistValue :: Interval -> PersistValue # | |
PersistFieldSql Interval Source # |
|
FromField Interval Source # | Uses |
Defined in Database.PostgreSQL.Simple.Interval.Unstable Methods | |
ToField Interval Source # | Uses |
Defined in Database.PostgreSQL.Simple.Interval.Unstable | |
Lift Interval Source # | |
The empty interval, representing no time at all.
>>>
zero
MkInterval {months = 0, days = 0, microseconds = 0}
fromMicroseconds :: Int64 -> Interval Source #
Creates an interval from a number of microseconds.
>>>
fromMicroseconds 1
MkInterval {months = 0, days = 0, microseconds = 1}
fromMilliseconds :: Int64 -> Maybe Interval Source #
Creates an interval from a number of milliseconds. Returns Nothing
if
the interval would overflow.
>>>
fromMilliseconds 1
Just (MkInterval {months = 0, days = 0, microseconds = 1000})>>>
fromMilliseconds 9223372036854776
Nothing
fromMillisecondsSaturating :: Int64 -> Interval Source #
Like fromMilliseconds
but uses saturating arithmetic rather than
returning Maybe
.
>>>
fromMillisecondsSaturating 1
MkInterval {months = 0, days = 0, microseconds = 1000}>>>
fromMillisecondsSaturating 9223372036854776
MkInterval {months = 0, days = 0, microseconds = 9223372036854775807}
fromMillisecondsLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 9223372036854775) => proxy n -> Interval Source #
Like fromMilliseconds
but takes a type-level natural number as input.
This is useful for writing literals without risk of overflow.
>>>
fromMillisecondsLiteral (Proxy :: Proxy 1)
MkInterval {months = 0, days = 0, microseconds = 1000}
fromSeconds :: Int64 -> Maybe Interval Source #
Creates an interval from a number of seconds. Returns Nothing
if the
interval would overflow.
>>>
fromSeconds 1
Just (MkInterval {months = 0, days = 0, microseconds = 1000000})>>>
fromSeconds 9223372036855
Nothing
fromSecondsSaturating :: Int64 -> Interval Source #
Like fromSeconds
but uses saturating arithmetic rather than returning
Maybe
.
>>>
fromSecondsSaturating 1
MkInterval {months = 0, days = 0, microseconds = 1000000}>>>
fromSecondsSaturating 9223372036855
MkInterval {months = 0, days = 0, microseconds = 9223372036854775807}
fromSecondsLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 9223372036854) => proxy n -> Interval Source #
Like fromSeconds
but takes a type-level natural number as input.
This is useful for writing literals without risk of overflow.
>>>
fromSecondsLiteral (Proxy :: Proxy 1)
MkInterval {months = 0, days = 0, microseconds = 1000000}
fromMinutes :: Int64 -> Maybe Interval Source #
Creates an interval from a number of minutes. Returns Nothing
if the
interval would overflow.
>>>
fromMinutes 1
Just (MkInterval {months = 0, days = 0, microseconds = 60000000})>>>
fromMinutes 153722867281
Nothing
fromMinutesSaturating :: Int64 -> Interval Source #
Like fromMinutes
but uses saturating arithmetic rather than returning
Maybe
.
>>>
fromMinutesSaturating 1
MkInterval {months = 0, days = 0, microseconds = 60000000}>>>
fromMinutesSaturating 153722867281
MkInterval {months = 0, days = 0, microseconds = 9223372036854775807}
fromMinutesLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 153722867280) => proxy n -> Interval Source #
Like fromMinutes
but takes a type-level natural number as input.
This is useful for writing literals without risk of overflow.
>>>
fromMinutesLiteral (Proxy :: Proxy 1)
MkInterval {months = 0, days = 0, microseconds = 60000000}
fromHours :: Int64 -> Maybe Interval Source #
Creates an interval from a number of hours. Returns Nothing
if the
interval would overflow.
>>>
fromHours 1
Just (MkInterval {months = 0, days = 0, microseconds = 3600000000})>>>
fromHours 2562047789
Nothing
fromHoursSaturating :: Int64 -> Interval Source #
fromHoursLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 2562047788) => proxy n -> Interval Source #
Like fromHours
but takes a type-level natural number as input.
This is useful for writing literals without risk of overflow.
>>>
fromHoursLiteral (Proxy :: Proxy 1)
MkInterval {months = 0, days = 0, microseconds = 3600000000}
fromDays :: Int32 -> Interval Source #
Creates an interval from a number of days.
>>>
fromDays 1
MkInterval {months = 0, days = 1, microseconds = 0}
fromWeeks :: Int32 -> Maybe Interval Source #
Creates an interval from a number of weeks. Returns Nothing
if the
interval would overflow.
>>>
fromWeeks 1
Just (MkInterval {months = 0, days = 7, microseconds = 0})>>>
fromWeeks 306783379
Nothing
fromWeeksSaturating :: Int32 -> Interval Source #
fromWeeksLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 306783378) => proxy n -> Interval Source #
Like fromWeeks
but takes a type-level natural number as input.
This is useful for writing literals without risk of overflow.
>>>
fromWeeksLiteral (Proxy :: Proxy 1)
MkInterval {months = 0, days = 7, microseconds = 0}
fromMonths :: Int32 -> Interval Source #
Creates an interval from a number of months.
>>>
fromMonths 1
MkInterval {months = 1, days = 0, microseconds = 0}
fromYears :: Int32 -> Maybe Interval Source #
Creates an interval from a number of years. Returns Nothing
if the
interval would overflow.
>>>
fromYears 1
Just (MkInterval {months = 12, days = 0, microseconds = 0})>>>
fromYears 178956971
Nothing
fromYearsSaturating :: Int32 -> Interval Source #
fromYearsLiteral :: forall (n :: Nat) proxy. (KnownNat n, n <= 178956970) => proxy n -> Interval Source #
Like fromYears
but takes a type-level natural number as input.
This is useful for writing literals without risk of overflow.
>>>
fromYearsLiteral (Proxy :: Proxy 1)
MkInterval {months = 12, days = 0, microseconds = 0}
negate :: Interval -> Maybe Interval Source #
Negates an interval. Returns Nothing
if the result would overflow.
>>>
negate (MkInterval 1 2 3)
Just (MkInterval {months = -1, days = -2, microseconds = -3})>>>
negate (MkInterval (-2147483648) 0 0)
Nothing
negateSaturating :: Interval -> Interval Source #
add :: Interval -> Interval -> Maybe Interval Source #
Adds two intervals. Returns Nothing
if the result would overflow.
>>>
add (fromMonths 1) (fromDays 2)
Just (MkInterval {months = 1, days = 2, microseconds = 0})>>>
add (fromDays 2147483647) (fromDays 1)
Nothing
intoTime :: Interval -> (CalendarDiffDays, NominalDiffTime) Source #
Converts an interval into types from the time
library. See fromTime
for the opposite conversion.
>>>
intoTime (MkInterval 1 2 3)
(P1M2D,0.000003s)
fromTime :: CalendarDiffDays -> NominalDiffTime -> Maybe Interval Source #
Converts types from the time
library into an interval. See intoTime
for the opposite conversion.
>>>
fromTime ('Time.CalendarDiffDays' 1 2) 3
Just (MkInterval {months = 1, days = 2, microseconds = 3000000})
Returns Nothing
if the result would overflow. See fromTimeSaturating
for
a version that uses saturating arithmetic instead.
>>>
fromTime mempty 9223372036854.775808
Nothing
Note that this truncates extra precision.
>>>
fromTime mempty 0.0000009
Just (MkInterval {months = 0, days = 0, microseconds = 0})
fromTimeSaturating :: CalendarDiffDays -> NominalDiffTime -> Interval Source #
Like fromTime
but uses saturating arithmetic rather than returning
Maybe
.
>>>
fromTimeSaturating ('Time.CalendarDiffDays' 1 2) 3
MkInterval {months = 1, days = 2, microseconds = 3000000}>>>
fromTimeSaturating mempty 9223372036854.775808
MkInterval {months = 1, days = 2, microseconds = 9223372036854775807}
scale :: Rational -> Interval -> Maybe Interval Source #
Scales an interval by the given ratio.
>>>
scale 0.5 (MkInterval 2 4 8)
Just (MkInterval {months = 1, days = 2, microseconds = 4})>>>
scale 2 (MkInterval 2 4 8)
Just (MkInterval {months = 4, days = 8, microseconds = 16})
Each component is rounded.
>>>
scale 0.4 (MkInterval 0 0 1) -- rounds down
Just (MkInterval {months = 0, days = 0, microseconds = 0})>>>
scale 0.5 (MkInterval 0 0 1) -- rounds half to even
Just (MkInterval {months = 0, days = 0, microseconds = 0})>>>
scale 0.6 (MkInterval 0 0 1) -- rounds up
Just (MkInterval {months = 0, days = 0, microseconds = 1})
Fractional days are converted into microseconds, assuming 24 hours per day.
>>>
scale 0.5 (MkInterval 0 1 0)
Just (MkInterval {months = 0, days = 0, microseconds = 43200000000})
Fractional months are converted into days, assuming 30 days per month.
>>>
scale 0.5 (MkInterval 1 0 0)
Just (MkInterval {months = 0, days = 15, microseconds = 0})
If this conversion produces fractional days, those are converted into microseconds.
>>>
scale 0.05 (MkInterval 1 0 0)
Just (MkInterval {months = 0, days = 1, microseconds = 43200000000})
Returns Nothing
if any component would overflow. See scaleSaturating
for
a version that uses saturating arithmetic instead.
>>>
scale 2 (MkInterval 0 0 4611686018427387904)
Nothing
Note that due to rounding and conversion, scaling down and then up will not necessarily return the original interval.
>>>
fmap (scale 2) (scale 0.5 (MkInterval 0 0 1))
Just (Just (MkInterval {months = 0, days = 0, microseconds = 0}))>>>
fmap (scale 2) (scale 0.5 (MkInterval 1 0 0))
Just (Just (MkInterval {months = 0, days = 30, microseconds = 0}))
render :: Interval -> Builder Source #
Renders an interval to a Builder
. This always has the same format:
"@ A mon B day C hour D min E sec F us"
, where A
, B
, C
, D
, E
,
and F
are signed integers.
This is not the most compact format, but it is very easy to interpret and does not require dealing with decimals (which could introduce precision problems).
>>>
render MkInterval { months = 0, days = -1, microseconds = 2 }
"@ 0 mon -1 day 0 hour 0 min 0 sec +2 us"
parse :: Parser Interval Source #
Parses an interval. This is not a general purpose parser. It only supports the formats that PostgreSQL generates.
parseIso8601 :: Parser [Component] Source #
parsePostgres :: Parser [Component] Source #
maybePlural :: ByteString -> Parser ByteString Source #
One component of an interval. This is used to retain arbitrary precision for as long as possible before converting. It also shows which components are accepted, like years and months.
Constructors
Years !Integer | |
Weeks !Integer | |
Months !Integer | |
Days !Integer | |
Hours !Integer | |
Minutes !Integer | |
Seconds !Scientific | |
Microseconds !Integer |
fromComponents :: (Alternative f, Traversable t) => t Component -> f Interval Source #
negateComponent :: Component -> Component Source #