postgresql-simple-interval 0.2025.7.12 → 0.2025.8.27

raw patch · 4 files changed

+386/−13 lines, 4 filesdep +postgresql-libpqPVP ok

version bump matches the API change (PVP)

Dependencies added: postgresql-libpq

API changes (from Hackage documentation)

Files

• postgresql-simple-interval.cabal +6/−3
• source/library/Database/PostgreSQL/Simple/Interval.hs +24/−0
• source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs +226/−0
• source/test-suite/Main.hs +130/−10

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-simple-interval-version: 0.2025.7.12+version: 0.2025.8.27 synopsis: A simple interval type for PostgreSQL. description:   This library provides a simple interval type for PostgreSQL. It supports@@ -28,7 +28,6 @@     base >=4.13 && <4.22,     bytestring >=0.10.10 && <0.13,     postgresql-simple ^>=0.7,-    text >=1.2.4 && <1.3 || >=2.0 && <2.2,    default-language: Haskell2010   ghc-options:@@ -64,6 +63,7 @@   build-depends:     persistent ^>=2.17,     scientific ^>=0.3.8,+    text >=1.2.4 && <1.3 || >=2.0 && <2.2,    -- cabal-gild: discover source/library   exposed-modules:@@ -74,7 +74,10 @@  test-suite postgresql-simple-interval-test-suite   import: executable-  build-depends: hspec ^>=2.11.12+  build-depends:+    hspec ^>=2.11.12,+    postgresql-libpq ^>=0.11,+   hs-source-dirs: source/test-suite   main-is: Main.hs   type: exitcode-stdio-1.0

@@ -1,5 +1,7 @@ module Database.PostgreSQL.Simple.Interval   ( Unstable.Interval (..),++    -- * Constructors     Unstable.zero,     Unstable.fromMicroseconds,     Unstable.fromMilliseconds,@@ -10,6 +12,28 @@     Unstable.fromWeeks,     Unstable.fromMonths,     Unstable.fromYears,++    -- ** Saturating+    Unstable.fromMillisecondsSaturating,+    Unstable.fromSecondsSaturating,+    Unstable.fromMinutesSaturating,+    Unstable.fromHoursSaturating,+    Unstable.fromWeeksSaturating,+    Unstable.fromYearsSaturating,++    -- ** Literal+    Unstable.fromMillisecondsLiteral,+    Unstable.fromSecondsLiteral,+    Unstable.fromMinutesLiteral,+    Unstable.fromHoursLiteral,+    Unstable.fromWeeksLiteral,+    Unstable.fromYearsLiteral,++    -- * Arithmetic+    Unstable.negate,+    Unstable.negateSaturating,+    Unstable.add,+    Unstable.addSaturating,   ) where 

@@ -1,5 +1,9 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  module Database.PostgreSQL.Simple.Interval.Unstable where @@ -20,6 +24,7 @@ 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+import qualified GHC.TypeLits as TypeLits  -- | This type represents a PostgreSQL interval. Intervals can have month, day, -- and microsecond components. Each component is bounded, so they are not@@ -110,6 +115,34 @@     . (* 1e3)     . toInteger +-- | 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}+fromMillisecondsSaturating :: Int.Int64 -> Interval+fromMillisecondsSaturating =+  fromMicroseconds+    . toIntegralSaturating+    . (* 1e3)+    . toInteger++-- | 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}+fromMillisecondsLiteral ::+  (TypeLits.KnownNat n, (TypeLits.<=) n 9223372036854775) =>+  proxy n ->+  Interval+fromMillisecondsLiteral =+  fromMillisecondsSaturating+    . fromInteger+    . TypeLits.natVal+ -- | Creates an interval from a number of seconds. Returns 'Nothing' if the -- interval would overflow. --@@ -124,6 +157,34 @@     . (* 1e6)     . toInteger +-- | 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}+fromSecondsSaturating :: Int.Int64 -> Interval+fromSecondsSaturating =+  fromMicroseconds+    . toIntegralSaturating+    . (* 1e6)+    . toInteger++-- | 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}+fromSecondsLiteral ::+  (TypeLits.KnownNat n, (TypeLits.<=) n 9223372036854) =>+  proxy n ->+  Interval+fromSecondsLiteral =+  fromSecondsSaturating+    . fromInteger+    . TypeLits.natVal+ -- | Creates an interval from a number of minutes. Returns 'Nothing' if the -- interval would overflow. --@@ -138,6 +199,34 @@     . (* 60e6)     . toInteger +-- | 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}+fromMinutesSaturating :: Int.Int64 -> Interval+fromMinutesSaturating =+  fromMicroseconds+    . toIntegralSaturating+    . (* 60e6)+    . toInteger++-- | 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}+fromMinutesLiteral ::+  (TypeLits.KnownNat n, (TypeLits.<=) n 153722867280) =>+  proxy n ->+  Interval+fromMinutesLiteral =+  fromMinutesSaturating+    . fromInteger+    . TypeLits.natVal+ -- | Creates an interval from a number of hours. Returns 'Nothing' if the -- interval would overflow. --@@ -152,6 +241,34 @@     . (* 3600e6)     . toInteger +-- | Like 'fromHours' but uses saturating arithmetic rather than returning+-- 'Maybe'.+--+-- >>> fromHoursSaturating 1+-- MkInterval {months = 0, days = 0, microseconds = 3600000000}+-- >>> fromHoursSaturating 2562047789+-- MkInterval {months = 0, days = 0, microseconds = 9223372036854775807}+fromHoursSaturating :: Int.Int64 -> Interval+fromHoursSaturating =+  fromMicroseconds+    . toIntegralSaturating+    . (* 3600e6)+    . toInteger++-- | 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}+fromHoursLiteral ::+  (TypeLits.KnownNat n, (TypeLits.<=) n 2562047788) =>+  proxy n ->+  Interval+fromHoursLiteral =+  fromHoursSaturating+    . fromInteger+    . TypeLits.natVal+ -- | Creates an interval from a number of days. -- -- >>> fromDays 1@@ -173,6 +290,34 @@     . (* 7)     . toInteger +-- | Like 'fromWeeks' but uses saturating arithmetic rather than returning+-- 'Maybe'.+--+-- >>> fromWeeksSaturating 1+-- MkInterval {months = 0, days = 7, microseconds = 0}+-- >>> fromWeeksSaturating 306783379+-- MkInterval {months = 0, days = 2147483647, microseconds = 0}+fromWeeksSaturating :: Int.Int32 -> Interval+fromWeeksSaturating =+  fromDays+    . toIntegralSaturating+    . (* 7)+    . toInteger++-- | 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}+fromWeeksLiteral ::+  (TypeLits.KnownNat n, (TypeLits.<=) n 306783378) =>+  proxy n ->+  Interval+fromWeeksLiteral =+  fromWeeksSaturating+    . fromInteger+    . TypeLits.natVal+ -- | Creates an interval from a number of months. -- -- >>> fromMonths 1@@ -194,6 +339,65 @@     . (* 12)     . toInteger +-- | Like 'fromYears' but uses saturating arithmetic rather than returning+-- 'Maybe'.+--+-- >>> fromYearsSaturating 1+-- MkInterval {months = 12, days = 0, microseconds = 0}+-- >>> fromYearsSaturating 178956971+-- MkInterval {months = 2147483647, days = 0, microseconds = 0}+fromYearsSaturating :: Int.Int32 -> Interval+fromYearsSaturating =+  fromMonths+    . toIntegralSaturating+    . (* 12)+    . toInteger++-- | 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}+fromYearsLiteral ::+  (TypeLits.KnownNat n, (TypeLits.<=) n 178956970) =>+  proxy n ->+  Interval+fromYearsLiteral =+  fromYearsSaturating+    . fromInteger+    . TypeLits.natVal++-- | 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+negate :: Interval -> Maybe Interval+negate x =+  let safeNegate :: (Bits.Bits a, Integral a) => a -> Maybe a+      safeNegate = Bits.toIntegralSized . Prelude.negate . toInteger+   in MkInterval+        <$> safeNegate (months x)+        <*> safeNegate (days x)+        <*> safeNegate (microseconds x)++-- | Like 'Database.PostgreSQL.Simple.Interval.Unstable.negate' but uses+-- saturating arithmetic rather than returning 'Maybe'.+--+-- >>> negateSaturating (MkInterval 1 2 3)+-- MkInterval {months = -1, days = -2, microseconds = -3}+-- >>> negateSaturating (MkInterval (-2147483648) 0 0)+-- MkInterval {months = 2147483647, days = 0, microseconds = 0}+negateSaturating :: Interval -> Interval+negateSaturating x =+  let safeNegate :: (Bounded a, Integral a) => a -> a+      safeNegate = toIntegralSaturating . Prelude.negate . toInteger+   in MkInterval+        (safeNegate $ months x)+        (safeNegate $ days x)+        (safeNegate $ microseconds x)+ -- | Adds two intervals. Returns 'Nothing' if the result would overflow. -- -- >>> add (fromMonths 1) (fromDays 2)@@ -209,6 +413,21 @@         <*> Function.on safeAdd days x y         <*> Function.on safeAdd microseconds x y +-- | Like 'add' but uses saturating arithmetic rather than returning 'Maybe'.+--+-- >>> addSaturating (fromMonths 1) (fromDays 2)+-- MkInterval {months = 1, days = 2, microseconds = 0}+-- >>> addSaturating (fromDays 2147483647) (fromDays 1)+-- MkInterval {months = 0, days = 2147483647, microseconds = 0}+addSaturating :: Interval -> Interval -> Interval+addSaturating x y =+  let safeAdd :: (Bounded a, Integral a) => a -> a -> a+      safeAdd n = toIntegralSaturating . Function.on (+) toInteger n+   in MkInterval+        (Function.on safeAdd months x y)+        (Function.on safeAdd days x y)+        (Function.on safeAdd microseconds x 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.@@ -391,3 +610,10 @@  negateComponentsWhen :: (Functor f) => Bool -> f Component -> f Component negateComponentsWhen p = if p then fmap negateComponent else id++toIntegralSaturating :: forall a b. (Integral a, Integral b, Bounded b) => a -> b+toIntegralSaturating x = case toInteger x of+  y+    | let lo = minBound :: b, y < toInteger lo -> lo+    | let hi = maxBound :: b, y > toInteger hi -> hi+    | otherwise -> fromInteger y

@@ -1,5 +1,7 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}  import qualified Control.Exception as Exception import qualified Control.Monad as Monad@@ -8,12 +10,13 @@ import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.Int as Int-import qualified Data.Text as Text+import qualified Data.Proxy as Proxy+import qualified Database.PostgreSQL.LibPQ as Pq import qualified Database.PostgreSQL.Simple as Postgres+import qualified Database.PostgreSQL.Simple.Internal as Postgres import qualified Database.PostgreSQL.Simple.Interval.Unstable as I import qualified Database.PostgreSQL.Simple.ToField as Postgres import qualified Test.Hspec as H-import qualified Text.Read as Read  main :: IO () main = H.hspec spec@@ -53,6 +56,35 @@       let actual = I.add (I.fromMicroseconds minBound) (I.fromMicroseconds (-1))       actual `H.shouldBe` Nothing +    H.describe "addSaturating" $ do+      H.it "succeeds without saturating" $ do+        let actual = I.addSaturating (I.MkInterval 1 2 3) (I.MkInterval 4 5 6)+        actual `H.shouldBe` I.MkInterval 5 7 9++      H.it "succeeds with saturating positive month" $ do+        let actual = I.addSaturating (I.fromMonths maxBound) (I.fromMonths 1)+        actual `H.shouldBe` I.MkInterval maxBound 0 0++      H.it "succeeds with saturating negative month" $ do+        let actual = I.addSaturating (I.fromMonths minBound) (I.fromMonths (-1))+        actual `H.shouldBe` I.MkInterval minBound 0 0++      H.it "succeeds with saturating positive day" $ do+        let actual = I.addSaturating (I.fromDays maxBound) (I.fromDays 1)+        actual `H.shouldBe` I.MkInterval 0 maxBound 0++      H.it "succeeds with saturating negative day" $ do+        let actual = I.addSaturating (I.fromDays minBound) (I.fromDays (-1))+        actual `H.shouldBe` I.MkInterval 0 minBound 0++      H.it "succeeds with saturating positive microsecond" $ do+        let actual = I.addSaturating (I.fromMicroseconds maxBound) (I.fromMicroseconds 1)+        actual `H.shouldBe` I.MkInterval 0 0 maxBound++      H.it "succeeds with saturating negative microsecond" $ do+        let actual = I.addSaturating (I.fromMicroseconds minBound) (I.fromMicroseconds (-1))+        actual `H.shouldBe` I.MkInterval 0 0 minBound+   H.describe "fromMicroseconds" $ do     H.it "works" $ do       I.fromMicroseconds 1 `H.shouldBe` I.MkInterval 0 0 1@@ -64,6 +96,17 @@     H.it "fails with overflow" $ do       I.fromMilliseconds maxBound `H.shouldBe` Nothing +  H.describe "fromMillisecondsSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.fromMillisecondsSaturating 1 `H.shouldBe` I.MkInterval 0 0 1e3++    H.it "succeeds with saturating" $ do+      I.fromMillisecondsSaturating maxBound `H.shouldBe` I.MkInterval 0 0 9223372036854775807++  H.describe "fromMillisecondsLiteral" $ do+    H.it "succeeds" $ do+      I.fromMillisecondsLiteral @1 Proxy.Proxy `H.shouldBe` I.MkInterval 0 0 1e3+   H.describe "fromSeconds" $ do     H.it "succeeds with no overflow" $ do       I.fromSeconds 1 `H.shouldBe` Just (I.MkInterval 0 0 1e6)@@ -71,6 +114,17 @@     H.it "fails with overflow" $ do       I.fromSeconds maxBound `H.shouldBe` Nothing +  H.describe "fromSecondsSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.fromSecondsSaturating 1 `H.shouldBe` I.MkInterval 0 0 1e6++    H.it "succeeds with saturating" $ do+      I.fromSecondsSaturating maxBound `H.shouldBe` I.MkInterval 0 0 9223372036854775807++  H.describe "fromSecondsLiteral" $ do+    H.it "succeeds" $ do+      I.fromSecondsLiteral @1 Proxy.Proxy `H.shouldBe` I.MkInterval 0 0 1e6+   H.describe "fromMinutes" $ do     H.it "succeeds with no overflow" $ do       I.fromMinutes 1 `H.shouldBe` Just (I.MkInterval 0 0 60e6)@@ -78,6 +132,17 @@     H.it "fails with overflow" $ do       I.fromMinutes maxBound `H.shouldBe` Nothing +  H.describe "fromMinutesSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.fromMinutesSaturating 1 `H.shouldBe` I.MkInterval 0 0 60e6++    H.it "succeeds with saturating" $ do+      I.fromMinutesSaturating maxBound `H.shouldBe` I.MkInterval 0 0 9223372036854775807++  H.describe "fromMinutesLiteral" $ do+    H.it "succeeds" $ do+      I.fromMinutesLiteral @1 Proxy.Proxy `H.shouldBe` I.MkInterval 0 0 60e6+   H.describe "fromHours" $ do     H.it "succeeds with no overflow" $ do       I.fromHours 1 `H.shouldBe` Just (I.MkInterval 0 0 3600e6)@@ -85,6 +150,17 @@     H.it "fails with overflow" $ do       I.fromHours maxBound `H.shouldBe` Nothing +  H.describe "fromHoursSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.fromHoursSaturating 1 `H.shouldBe` I.MkInterval 0 0 3600e6++    H.it "succeeds with saturating" $ do+      I.fromHoursSaturating maxBound `H.shouldBe` I.MkInterval 0 0 9223372036854775807++  H.describe "fromHoursLiteral" $ do+    H.it "succeeds" $ do+      I.fromHoursLiteral @1 Proxy.Proxy `H.shouldBe` I.MkInterval 0 0 3600e6+   H.describe "fromDays" $ do     H.it "works" $ do       I.fromDays 1 `H.shouldBe` I.MkInterval 0 1 0@@ -96,6 +172,17 @@     H.it "fails with overflow" $ do       I.fromWeeks maxBound `H.shouldBe` Nothing +  H.describe "fromWeeksSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.fromWeeksSaturating 1 `H.shouldBe` I.MkInterval 0 7 0++    H.it "succeeds with saturating" $ do+      I.fromWeeksSaturating maxBound `H.shouldBe` I.MkInterval 0 2147483647 0++  H.describe "fromWeeksLiteral" $ do+    H.it "succeeds" $ do+      I.fromWeeksLiteral @1 Proxy.Proxy `H.shouldBe` I.MkInterval 0 7 0+   H.describe "fromMonths" $ do     H.it "works" $ do       I.fromMonths 1 `H.shouldBe` I.MkInterval 1 0 0@@ -107,6 +194,43 @@     H.it "fails with overflow" $ do       I.fromYears maxBound `H.shouldBe` Nothing +  H.describe "fromYearsSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.fromYearsSaturating 1 `H.shouldBe` I.MkInterval 12 0 0++    H.it "succeeds with saturating" $ do+      I.fromYearsSaturating maxBound `H.shouldBe` I.MkInterval 2147483647 0 0++  H.describe "fromYearsLiteral" $ do+    H.it "succeeds" $ do+      I.fromYearsLiteral @1 Proxy.Proxy `H.shouldBe` I.MkInterval 12 0 0++  H.describe "negate" $ do+    H.it "succeeds with no overflow" $ do+      I.negate (I.MkInterval 1 2 3) `H.shouldBe` Just (I.MkInterval (-1) (-2) (-3))++    H.it "fails with month overflow" $ do+      I.negate (I.MkInterval minBound 0 0) `H.shouldBe` Nothing++    H.it "fails with day overflow" $ do+      I.negate (I.MkInterval 0 minBound 0) `H.shouldBe` Nothing++    H.it "fails with microsecond overflow" $ do+      I.negate (I.MkInterval 0 0 minBound) `H.shouldBe` Nothing++  H.describe "negateSaturating" $ do+    H.it "succeeds without saturating" $ do+      I.negateSaturating (I.MkInterval 1 2 3) `H.shouldBe` I.MkInterval (-1) (-2) (-3)++    H.it "succeeds with saturating month" $ do+      I.negateSaturating (I.MkInterval minBound 0 0) `H.shouldBe` I.MkInterval maxBound 0 0++    H.it "succeeds with saturating day" $ do+      I.negateSaturating (I.MkInterval 0 minBound 0) `H.shouldBe` I.MkInterval 0 maxBound 0++    H.it "succeeds with saturating microsecond" $ do+      I.negateSaturating (I.MkInterval 0 0 minBound) `H.shouldBe` I.MkInterval 0 0 maxBound+   H.describe "render" $ do     H.it "works with zero" $ do       let actual = Builder.toLazyByteString $ I.render I.zero@@ -165,14 +289,10 @@               case result of                 Right actual -> actual `H.shouldBe` [Postgres.Only interval]                 Left somePostgresqlException -> do-                  rows <- Postgres.query_ connection "select version()"-                  case rows of-                    Postgres.Only text : _-                      | _ : rawVersion : _ <- Text.words text,-                        Just version <- Read.readMaybe (Text.unpack rawVersion),-                        version < (15 :: Double) ->-                          H.pendingWith $ "interval parsing broken with PostgreSQL version " <> show version-                    _ -> Exception.throwIO (somePostgresqlException :: Postgres.SomePostgreSqlException)+                  version <- Postgres.withConnection connection Pq.serverVersion+                  if version < 150000+                    then H.pendingWith $ "interval parsing broken with PostgreSQL version " <> show version+                    else Exception.throwIO (somePostgresqlException :: Postgres.SomePostgreSqlException)  data IntervalStyle   = Iso8601