{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}

module Database.PostgreSQL.Simple.Interval.Unstable where

import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Char8 as Ascii
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Function as Function
import qualified Data.Int as Int
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import qualified Database.Persist as Persist
import qualified Database.Persist.Sql as Persist
import qualified Database.PostgreSQL.Simple.FromField as Postgres
import qualified Database.PostgreSQL.Simple.ToField as Postgres
import qualified Database.PostgreSQL.Simple.TypeInfo.Static as Postgres

-- | 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:
--
-- - 'Data.Time.NominalDiffTime': Does not handle days or months. Allows up to
--   picosecond precision. Is not bounded.
-- - 'Data.Time.CalendarDiffTime': Does not handle days. Embeds a
--   @NominalDiffTime@. Is not bounded.
-- - 'Data.Time.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>
data Interval = MkInterval
  { Interval -> Int32
months :: !Int.Int32,
    Interval -> Int32
days :: !Int.Int32,
    Interval -> Int64
microseconds :: !Int.Int64
  }
  deriving (Interval -> Interval -> Bool
(Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool) -> Eq Interval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
/= :: Interval -> Interval -> Bool
Eq, Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
(Int -> Interval -> ShowS)
-> (Interval -> String) -> ([Interval] -> ShowS) -> Show Interval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Interval -> ShowS
showsPrec :: Int -> Interval -> ShowS
$cshow :: Interval -> String
show :: Interval -> String
$cshowList :: [Interval] -> ShowS
showList :: [Interval] -> ShowS
Show)

-- | Uses 'parse'. Ensures that the OID is 'Postgres.intervalOid'.
instance Postgres.FromField Interval where
  fromField :: FieldParser Interval
fromField = (Oid -> Bool) -> Parser Interval -> FieldParser Interval
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
Postgres.attoFieldParser (Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Postgres.intervalOid) Parser Interval
parse

-- | Uses 'render'. Always includes an @interval@ prefix, like
-- @interval '...'@.
instance Postgres.ToField Interval where
  toField :: Interval -> Action
toField = Builder -> Action
Postgres.Plain (Builder -> Action) -> (Interval -> Builder) -> Interval -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"interval '" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> (Interval -> Builder) -> Interval -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'") (Builder -> Builder)
-> (Interval -> Builder) -> Interval -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval -> Builder
render

-- | Behaves the same as the 'Postgres.FromField' and 'Postgres.ToField'
-- instances.
instance Persist.PersistField Interval where
  fromPersistValue :: PersistValue -> Either Text Interval
fromPersistValue PersistValue
persistValue = case PersistValue
persistValue of
    Persist.PersistLiteralEscaped ByteString
byteString
      | Right Interval
interval <- Parser Interval -> ByteString -> Either String Interval
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Interval
parse ByteString
byteString ->
          Interval -> Either Text Interval
forall a b. b -> Either a b
Right Interval
interval
    Persist.PersistLiteral ByteString
byteString
      | Just ByteString
withoutPrefix <- ByteString -> ByteString -> Maybe ByteString
Ascii.stripPrefix ByteString
"interval '" ByteString
byteString,
        Just ByteString
withoutSuffix <- ByteString -> ByteString -> Maybe ByteString
Ascii.stripSuffix ByteString
"'" ByteString
withoutPrefix,
        Right Interval
interval <- Parser Interval -> ByteString -> Either String Interval
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Interval
parse ByteString
withoutSuffix ->
          Interval -> Either Text Interval
forall a b. b -> Either a b
Right Interval
interval
    PersistValue
_ -> Text -> Either Text Interval
forall a b. a -> Either a b
Left (Text -> Either Text Interval) -> Text -> Either Text Interval
forall a b. (a -> b) -> a -> b
$ Text
"Invalid interval: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
persistValue)
  toPersistValue :: Interval -> PersistValue
toPersistValue =
    ByteString -> PersistValue
Persist.PersistLiteral
      (ByteString -> PersistValue)
-> (Interval -> ByteString) -> Interval -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
LazyByteString.toStrict
      (LazyByteString -> ByteString)
-> (Interval -> LazyByteString) -> Interval -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
Builder.toLazyByteString
      (Builder -> LazyByteString)
-> (Interval -> Builder) -> Interval -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"interval '" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>)
      (Builder -> Builder)
-> (Interval -> Builder) -> Interval -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'")
      (Builder -> Builder)
-> (Interval -> Builder) -> Interval -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval -> Builder
render

-- | @'Persist.SqlOther' "interval"@
instance Persist.PersistFieldSql Interval where
  sqlType :: Proxy Interval -> SqlType
sqlType = SqlType -> Proxy Interval -> SqlType
forall a b. a -> b -> a
const (SqlType -> Proxy Interval -> SqlType)
-> SqlType -> Proxy Interval -> SqlType
forall a b. (a -> b) -> a -> b
$ Text -> SqlType
Persist.SqlOther Text
"interval"

-- | The empty interval, representing no time at all.
--
-- >>> zero
-- MkInterval {months = 0, days = 0, microseconds = 0}
zero :: Interval
zero :: Interval
zero = Int32 -> Int32 -> Int64 -> Interval
MkInterval Int32
0 Int32
0 Int64
0

-- | Creates an interval from a number of microseconds.
--
-- >>> fromMicroseconds 1
-- MkInterval {months = 0, days = 0, microseconds = 1}
fromMicroseconds :: Int.Int64 -> Interval
fromMicroseconds :: Int64 -> Interval
fromMicroseconds Int64
x = Interval
zero {microseconds = x}

-- | 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
fromMilliseconds :: Int.Int64 -> Maybe Interval
fromMilliseconds :: Int64 -> Maybe Interval
fromMilliseconds =
  (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Interval
fromMicroseconds
    (Maybe Int64 -> Maybe Interval)
-> (Int64 -> Maybe Int64) -> Int64 -> Maybe Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
    (Integer -> Maybe Int64)
-> (Int64 -> Integer) -> Int64 -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1e3)
    (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | 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
fromSeconds :: Int.Int64 -> Maybe Interval
fromSeconds :: Int64 -> Maybe Interval
fromSeconds =
  (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Interval
fromMicroseconds
    (Maybe Int64 -> Maybe Interval)
-> (Int64 -> Maybe Int64) -> Int64 -> Maybe Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
    (Integer -> Maybe Int64)
-> (Int64 -> Integer) -> Int64 -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1e6)
    (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | 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
fromMinutes :: Int.Int64 -> Maybe Interval
fromMinutes :: Int64 -> Maybe Interval
fromMinutes =
  (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Interval
fromMicroseconds
    (Maybe Int64 -> Maybe Interval)
-> (Int64 -> Maybe Int64) -> Int64 -> Maybe Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
    (Integer -> Maybe Int64)
-> (Int64 -> Integer) -> Int64 -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60e6)
    (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | 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
fromHours :: Int.Int64 -> Maybe Interval
fromHours :: Int64 -> Maybe Interval
fromHours =
  (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Interval
fromMicroseconds
    (Maybe Int64 -> Maybe Interval)
-> (Int64 -> Maybe Int64) -> Int64 -> Maybe Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
    (Integer -> Maybe Int64)
-> (Int64 -> Integer) -> Int64 -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
3600e6)
    (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | Creates an interval from a number of days.
--
-- >>> fromDays 1
-- MkInterval {months = 0, days = 1, microseconds = 0}
fromDays :: Int.Int32 -> Interval
fromDays :: Int32 -> Interval
fromDays Int32
x = Interval
zero {days = x}

-- | 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
fromWeeks :: Int.Int32 -> Maybe Interval
fromWeeks :: Int32 -> Maybe Interval
fromWeeks =
  (Int32 -> Interval) -> Maybe Int32 -> Maybe Interval
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Interval
fromDays
    (Maybe Int32 -> Maybe Interval)
-> (Int32 -> Maybe Int32) -> Int32 -> Maybe Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
    (Integer -> Maybe Int32)
-> (Int32 -> Integer) -> Int32 -> Maybe Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7)
    (Integer -> Integer) -> (Int32 -> Integer) -> Int32 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | Creates an interval from a number of months.
--
-- >>> fromMonths 1
-- MkInterval {months = 1, days = 0, microseconds = 0}
fromMonths :: Int.Int32 -> Interval
fromMonths :: Int32 -> Interval
fromMonths Int32
x = Interval
zero {months = x}

-- | 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
fromYears :: Int.Int32 -> Maybe Interval
fromYears :: Int32 -> Maybe Interval
fromYears =
  (Int32 -> Interval) -> Maybe Int32 -> Maybe Interval
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Interval
fromMonths
    (Maybe Int32 -> Maybe Interval)
-> (Int32 -> Maybe Int32) -> Int32 -> Maybe Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
    (Integer -> Maybe Int32)
-> (Int32 -> Integer) -> Int32 -> Maybe Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12)
    (Integer -> Integer) -> (Int32 -> Integer) -> Int32 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | 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
add :: Interval -> Interval -> Maybe Interval
add :: Interval -> Interval -> Maybe Interval
add Interval
x Interval
y =
  let safeAdd :: (Bits.Bits a, Integral a) => a -> a -> Maybe a
      safeAdd :: forall a. (Bits a, Integral a) => a -> a -> Maybe a
safeAdd a
n = Integer -> Maybe a
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized (Integer -> Maybe a) -> (a -> Integer) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer)
-> (a -> Integer) -> a -> a -> Integer
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n
   in Int32 -> Int32 -> Int64 -> Interval
MkInterval
        (Int32 -> Int32 -> Int64 -> Interval)
-> Maybe Int32 -> Maybe (Int32 -> Int64 -> Interval)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int32 -> Int32 -> Maybe Int32)
-> (Interval -> Int32) -> Interval -> Interval -> Maybe Int32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on Int32 -> Int32 -> Maybe Int32
forall a. (Bits a, Integral a) => a -> a -> Maybe a
safeAdd Interval -> Int32
months Interval
x Interval
y
        Maybe (Int32 -> Int64 -> Interval)
-> Maybe Int32 -> Maybe (Int64 -> Interval)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int32 -> Int32 -> Maybe Int32)
-> (Interval -> Int32) -> Interval -> Interval -> Maybe Int32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on Int32 -> Int32 -> Maybe Int32
forall a. (Bits a, Integral a) => a -> a -> Maybe a
safeAdd Interval -> Int32
days Interval
x Interval
y
        Maybe (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int64 -> Int64 -> Maybe Int64)
-> (Interval -> Int64) -> Interval -> Interval -> Maybe Int64
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on Int64 -> Int64 -> Maybe Int64
forall a. (Bits a, Integral a) => a -> a -> Maybe a
safeAdd Interval -> Int64
microseconds Interval
x Interval
y

-- | 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"
render :: Interval -> Builder.Builder
render :: Interval -> Builder
render Interval
x =
  let signed :: (Num a, Ord a) => (a -> Builder.Builder) -> a -> Builder.Builder
      signed :: forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed a -> Builder
f a
n = (if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then Builder
"+" else Builder
"") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
f a
n
      (Int64
t1, Int64
u) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem (Interval -> Int64
microseconds Interval
x) Int64
1000000
      (Int64
t2, Int64
s) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
t1 Int64
60
      (Int64
h, Int64
m) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
t2 Int64
60
   in Builder
"@ "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int32 -> Builder) -> Int32 -> Builder
forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed Int32 -> Builder
Builder.int32Dec (Interval -> Int32
months Interval
x)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" mon "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int32 -> Builder) -> Int32 -> Builder
forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed Int32 -> Builder
Builder.int32Dec (Interval -> Int32
days Interval
x)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" day "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int64 -> Builder) -> Int64 -> Builder
forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed Int64 -> Builder
Builder.int64Dec Int64
h
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" hour "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int64 -> Builder) -> Int64 -> Builder
forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed Int64 -> Builder
Builder.int64Dec Int64
m
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" min "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int64 -> Builder) -> Int64 -> Builder
forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed Int64 -> Builder
Builder.int64Dec Int64
s
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" sec "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int64 -> Builder) -> Int64 -> Builder
forall a. (Num a, Ord a) => (a -> Builder) -> a -> Builder
signed Int64 -> Builder
Builder.int64Dec Int64
u
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" us"

-- | Parses an interval. This is not a general purpose parser. It only supports
-- the formats that PostgreSQL generates. For example, it will fail to parse an
-- interval like @"1 week"@ because PostgreSQL never uses weeks when rendering
-- intervals.
parse :: A.Parser Interval
parse :: Parser Interval
parse =
  -- Start with parsers that have non-empty prefixes, in order to avoid
  -- ambiguity. Neither of the `postgres` nor `sql_standard` interval styles
  -- have a prefix (or suffix), so whichever one is attempted first needs to
  -- make sure it has consumed all of the input.
  [Parser Interval] -> Parser Interval
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser Interval] -> Parser Interval)
-> [Parser Interval] -> Parser Interval
forall a b. (a -> b) -> a -> b
$
    Parser Interval
parseInfinities
      Parser Interval -> [Parser Interval] -> [Parser Interval]
forall a. a -> [a] -> [a]
: (Parser ByteString [Component] -> Parser Interval)
-> [Parser ByteString [Component]] -> [Parser Interval]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ([Component] -> Parser Interval
forall (f :: * -> *) (t :: * -> *).
(Alternative f, Traversable t) =>
t Component -> f Interval
fromComponents ([Component] -> Parser Interval)
-> Parser ByteString [Component] -> Parser Interval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
        [ Parser ByteString [Component]
parseIso8601,
          Parser ByteString [Component]
parsePostgresVerbose,
          Parser ByteString [Component]
parsePostgres Parser ByteString [Component]
-> Parser ByteString () -> Parser ByteString [Component]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput,
          Parser ByteString [Component]
parseSqlStandard Parser ByteString [Component]
-> Parser ByteString () -> Parser ByteString [Component]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput
        ]

parseInfinities :: A.Parser Interval
parseInfinities :: Parser Interval
parseInfinities =
  -- Both `-infinity` and `infinity` are new as of PostgreSQL 17.0.
  -- https://www.postgresql.org/message-id/E1r2rB1-005PHm-UL%40gemulon.postgresql.org
  [Parser Interval] -> Parser Interval
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
    [ Int32 -> Int32 -> Int64 -> Interval
MkInterval Int32
forall a. Bounded a => a
minBound Int32
forall a. Bounded a => a
minBound Int64
forall a. Bounded a => a
minBound Interval -> Parser ByteString ByteString -> Parser Interval
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"-infinity",
      Int32 -> Int32 -> Int64 -> Interval
MkInterval Int32
forall a. Bounded a => a
maxBound Int32
forall a. Bounded a => a
maxBound Int64
forall a. Bounded a => a
maxBound Interval -> Parser ByteString ByteString -> Parser Interval
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"infinity"
    ]

parseIso8601 :: A.Parser [Component]
parseIso8601 :: Parser ByteString [Component]
parseIso8601 = do
  Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void Parser ByteString ByteString
"P"
  dates <-
    Parser ByteString Component -> Parser ByteString [Component]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' (Parser ByteString Component -> Parser ByteString [Component])
-> Parser ByteString Component -> Parser ByteString [Component]
forall a b. (a -> b) -> a -> b
$
      [Parser ByteString Component] -> Parser ByteString Component
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
        [ Integer -> Component
Years (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"Y",
          Integer -> Component
Months (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"M",
          Integer -> Component
Days (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"D"
        ]
  times <- A.option [] $ do
    Monad.void "T"
    A.many' $
      A.choice
        [ Hours <$> A.signed A.decimal <* "H",
          Minutes <$> A.signed A.decimal <* "M",
          Seconds <$> A.signed A.scientific <* "S"
        ]
  pure $ dates <> times

parsePostgresVerbose :: A.Parser [Component]
parsePostgresVerbose :: Parser ByteString [Component]
parsePostgresVerbose = do
  Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void Parser ByteString ByteString
"@ "
  components <-
    (Parser ByteString Component
 -> Parser ByteString ByteString -> Parser ByteString [Component])
-> Parser ByteString ByteString
-> Parser ByteString Component
-> Parser ByteString [Component]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString [Component]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser ByteString ByteString
" " (Parser ByteString Component -> Parser ByteString [Component])
-> Parser ByteString Component -> Parser ByteString [Component]
forall a b. (a -> b) -> a -> b
$
      [Parser ByteString Component] -> Parser ByteString Component
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
        [ Integer -> Component
Years (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" year",
          Integer -> Component
Months (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" mon",
          Integer -> Component
Days (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" day",
          Integer -> Component
Hours (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" hour",
          Integer -> Component
Minutes (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" min",
          Integer -> Component
Microseconds (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" us",
          Scientific -> Component
Seconds (Scientific -> Component)
-> Parser ByteString Scientific -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Scientific -> Parser ByteString Scientific
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Scientific
A.scientific Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option ByteString
"" (ByteString -> Parser ByteString ByteString
maybePlural ByteString
" sec")
        ]
  ago <- A.option "" " ago"
  pure $ negateComponentsWhen (not $ ByteString.null ago) components

parsePostgres :: A.Parser [Component]
parsePostgres :: Parser ByteString [Component]
parsePostgres = do
  dates <-
    (Parser ByteString Component
 -> Parser ByteString ByteString -> Parser ByteString [Component])
-> Parser ByteString ByteString
-> Parser ByteString Component
-> Parser ByteString [Component]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString [Component]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser ByteString ByteString
" " (Parser ByteString Component -> Parser ByteString [Component])
-> Parser ByteString Component -> Parser ByteString [Component]
forall a b. (a -> b) -> a -> b
$
      [Parser ByteString Component] -> Parser ByteString Component
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
        [ Integer -> Component
Years (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" year",
          Integer -> Component
Months (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" mon",
          Integer -> Component
Days (Integer -> Component)
-> Parser ByteString Integer -> Parser ByteString Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal Parser ByteString Component
-> Parser ByteString ByteString -> Parser ByteString Component
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
maybePlural ByteString
" day"
        ]
  time <- A.option [] $ A.skipSpace *> parseTime
  pure $ dates <> time

parseSqlStandard :: A.Parser [Component]
parseSqlStandard :: Parser ByteString [Component]
parseSqlStandard = do
  let parseYearsAndMonths :: Parser ByteString [Component]
parseYearsAndMonths = do
        sign <- Parser ByteString ByteString
parseSign
        years <- Years <$> A.decimal <* "-"
        months_ <- Months <$> A.decimal
        pure $ negateComponentsWhen (sign == "-") [years, months_]
  let parseDays :: Parser ByteString [Component]
parseDays = (Component -> [Component] -> [Component]
forall a. a -> [a] -> [a]
: []) (Component -> [Component])
-> (Integer -> Component) -> Integer -> [Component]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Component
Days (Integer -> [Component])
-> Parser ByteString Integer -> Parser ByteString [Component]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer -> Parser ByteString Integer
forall a. Num a => Parser a -> Parser a
A.signed Parser ByteString Integer
forall a. Integral a => Parser a
A.decimal
  let parsers :: [Parser ByteString [Component]]
parsers = [Parser ByteString [Component]
parseYearsAndMonths, Parser ByteString [Component]
parseTime, Parser ByteString [Component]
parseDays]
  [[Component]] -> [Component]
forall a. Monoid a => [a] -> a
mconcat ([[Component]] -> [Component])
-> Parser ByteString [[Component]] -> Parser ByteString [Component]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [Component]
-> Parser ByteString ByteString -> Parser ByteString [[Component]]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy1 ([Parser ByteString [Component]] -> Parser ByteString [Component]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice [Parser ByteString [Component]]
parsers) Parser ByteString ByteString
" "

parseTime :: A.Parser [Component]
parseTime :: Parser ByteString [Component]
parseTime = do
  sign <- Parser ByteString ByteString
parseSign
  hours <- Hours <$> A.decimal <* ":"
  minutes <- Minutes <$> A.decimal <* ":"
  seconds <- Seconds <$> A.scientific
  pure $ negateComponentsWhen (sign == "-") [hours, minutes, seconds]

parseSign :: A.Parser ByteString.ByteString
parseSign :: Parser ByteString ByteString
parseSign = [Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice [Parser ByteString ByteString
"-", Parser ByteString ByteString
"+", Parser ByteString ByteString
""]

maybePlural :: ByteString.ByteString -> A.Parser ByteString.ByteString
maybePlural :: ByteString -> Parser ByteString ByteString
maybePlural ByteString
word = ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Parser ByteString ByteString
A.string ByteString
word Parser ByteString (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option ByteString
"" Parser ByteString ByteString
"s"

-- | 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.
data Component
  = Years !Integer
  | Months !Integer
  | Days !Integer
  | Hours !Integer
  | Minutes !Integer
  | Seconds !Scientific.Scientific
  | Microseconds !Integer
  deriving (Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
/= :: Component -> Component -> Bool
Eq, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Component -> ShowS
showsPrec :: Int -> Component -> ShowS
$cshow :: Component -> String
show :: Component -> String
$cshowList :: [Component] -> ShowS
showList :: [Component] -> ShowS
Show)

-- | Converts a 'Component' to an 'Interval'. Returns 'Nothing' if the
-- component would overflow.
fromComponent :: Component -> Maybe Interval
fromComponent :: Component -> Maybe Interval
fromComponent Component
c = case Component
c of
  Years Integer
y -> Int32 -> Maybe Interval
fromYears (Int32 -> Maybe Interval) -> Maybe Int32 -> Maybe Interval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized Integer
y
  Months Integer
m -> Int32 -> Interval
fromMonths (Int32 -> Interval) -> Maybe Int32 -> Maybe Interval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized Integer
m
  Days Integer
d -> Int32 -> Interval
fromDays (Int32 -> Interval) -> Maybe Int32 -> Maybe Interval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized Integer
d
  Hours Integer
h -> Int64 -> Maybe Interval
fromHours (Int64 -> Maybe Interval) -> Maybe Int64 -> Maybe Interval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized Integer
h
  Minutes Integer
m -> Int64 -> Maybe Interval
fromMinutes (Int64 -> Maybe Interval) -> Maybe Int64 -> Maybe Interval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized Integer
m
  Seconds Scientific
u -> Int64 -> Interval
fromMicroseconds (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> Maybe Int64
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger (Scientific
u Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
1e6)
  Microseconds Integer
u -> Int64 -> Interval
fromMicroseconds (Int64 -> Interval) -> Maybe Int64 -> Maybe Interval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized Integer
u

-- | Converts a list of 'Component's to an 'Interval'. Returns 'Nothing' if any
-- of the components would overflow, or if adding any of them together would
-- overflow.
fromComponents ::
  (Applicative.Alternative f, Traversable t) =>
  t Component ->
  f Interval
fromComponents :: forall (f :: * -> *) (t :: * -> *).
(Alternative f, Traversable t) =>
t Component -> f Interval
fromComponents =
  f Interval
-> (Interval -> f Interval) -> Maybe Interval -> f Interval
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f Interval
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty Interval -> f Interval
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe Interval -> f Interval)
-> (t Component -> Maybe Interval) -> t Component -> f Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Interval -> Interval -> Maybe Interval)
-> Interval -> t Interval -> Maybe Interval
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Interval -> Interval -> Maybe Interval
add Interval
zero (t Interval -> Maybe Interval)
-> (t Component -> Maybe (t Interval))
-> t Component
-> Maybe Interval
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
Monad.<=< (Component -> Maybe Interval) -> t Component -> Maybe (t Interval)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse Component -> Maybe Interval
fromComponent)

negateComponent :: Component -> Component
negateComponent :: Component -> Component
negateComponent Component
c = case Component
c of
  Years Integer
y -> Integer -> Component
Years (-Integer
y)
  Months Integer
m -> Integer -> Component
Months (-Integer
m)
  Days Integer
d -> Integer -> Component
Days (-Integer
d)
  Hours Integer
h -> Integer -> Component
Hours (-Integer
h)
  Minutes Integer
m -> Integer -> Component
Minutes (-Integer
m)
  Seconds Scientific
u -> Scientific -> Component
Seconds (-Scientific
u)
  Microseconds Integer
u -> Integer -> Component
Microseconds (-Integer
u)

negateComponentsWhen :: (Functor f) => Bool -> f Component -> f Component
negateComponentsWhen :: forall (f :: * -> *).
Functor f =>
Bool -> f Component -> f Component
negateComponentsWhen Bool
p = if Bool
p then (Component -> Component) -> f Component -> f Component
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Component -> Component
negateComponent else f Component -> f Component
forall a. a -> a
id