diff --git a/postgresql-simple-interval.cabal b/postgresql-simple-interval.cabal --- a/postgresql-simple-interval.cabal +++ b/postgresql-simple-interval.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-simple-interval -version: 0.2025.9.5 +version: 1.0.0.0 synopsis: A simple interval type for PostgreSQL. description: This library provides a simple interval type for PostgreSQL. It supports diff --git a/source/library/Database/PostgreSQL/Simple/Interval.hs b/source/library/Database/PostgreSQL/Simple/Interval.hs --- a/source/library/Database/PostgreSQL/Simple/Interval.hs +++ b/source/library/Database/PostgreSQL/Simple/Interval.hs @@ -37,12 +37,14 @@ Unstable.fromTimeSaturating, -- * Arithmetic - Unstable.negate, Unstable.add, + Unstable.negate, + Unstable.scale, -- ** Saturating - Unstable.negateSaturating, Unstable.addSaturating, + Unstable.negateSaturating, + Unstable.scaleSaturating, ) where diff --git a/source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs b/source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs --- a/source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs +++ b/source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs @@ -376,13 +376,7 @@ -- >>> 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) +negate = scale (-1) -- | Like 'Database.PostgreSQL.Simple.Interval.Unstable.negate' but uses -- saturating arithmetic rather than returning 'Maybe'. @@ -392,13 +386,7 @@ -- >>> 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) +negateSaturating = scaleSaturating (-1) -- | Adds two intervals. Returns 'Nothing' if the result would overflow. -- @@ -490,6 +478,76 @@ fromMicro :: Fixed.Micro -> Integer fromMicro (Fixed.MkFixed x) = x + +-- | 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})) +scale :: Rational -> Interval -> Maybe Interval +scale r i = do + let (m :: Integer, mf) = properFraction . (*) r . toRational $ months i + let (d :: Integer, uf) = properFraction . (+) (mf * 30) . (*) r . toRational $ days i + let u :: Integer = round . (+) (uf * 86400000000) . (*) r . toRational $ microseconds i + MkInterval + <$> Bits.toIntegralSized m + <*> Bits.toIntegralSized d + <*> Bits.toIntegralSized u + +-- | Like 'scale' but uses saturating arithmetic rather than returning +-- 'Nothing' on overflow. +-- +-- >>> scaleSaturating 2 (MkInterval 0 0 4611686018427387904) +-- MkInterval {months = 0, days = 0, microseconds = 9223372036854775807} +scaleSaturating :: Rational -> Interval -> Interval +scaleSaturating r i = + let (m :: Integer, mf) = properFraction . (*) r . toRational $ months i + (d :: Integer, uf) = properFraction . (+) (mf * 30) . (*) r . toRational $ days i + u :: Integer = round . (+) (uf * 86400000000) . (*) r . toRational $ microseconds i + in MkInterval + (toIntegralSaturating m) + (toIntegralSaturating d) + (toIntegralSaturating u) -- | 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@, diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs --- a/source/test-suite/Main.hs +++ b/source/test-suite/Main.hs @@ -268,6 +268,110 @@ H.it "works with saturating months" $ do I.fromTimeSaturating (Time.CalendarDiffDays 2147483648 0) 0 `H.shouldBe` I.MkInterval maxBound 0 0 + H.describe "scale" $ do + H.describe "microseconds" $ do + H.it "scales up" $ do + I.scale 2 (I.MkInterval 0 0 1) `H.shouldBe` Just (I.MkInterval 0 0 2) + + H.it "scales down" $ do + I.scale 0.5 (I.MkInterval 0 0 2) `H.shouldBe` Just (I.MkInterval 0 0 1) + + H.it "rounds down" $ do + I.scale 0.4 (I.MkInterval 0 0 1) `H.shouldBe` Just (I.MkInterval 0 0 0) + + H.it "rounds up" $ do + I.scale 0.6 (I.MkInterval 0 0 1) `H.shouldBe` Just (I.MkInterval 0 0 1) + + H.it "rounds half down to even" $ do + I.scale 0.5 (I.MkInterval 0 0 1) `H.shouldBe` Just (I.MkInterval 0 0 0) + + H.it "rounds half up to even" $ do + I.scale 0.5 (I.MkInterval 0 0 3) `H.shouldBe` Just (I.MkInterval 0 0 2) + + H.it "fails with overflow" $ do + I.scale 2 (I.MkInterval 0 0 4611686018427387904) `H.shouldBe` Nothing + + H.describe "days" $ do + H.it "scales up" $ do + I.scale 2 (I.MkInterval 0 1 0) `H.shouldBe` Just (I.MkInterval 0 2 0) + + H.it "scales down" $ do + I.scale 0.5 (I.MkInterval 0 2 0) `H.shouldBe` Just (I.MkInterval 0 1 0) + + H.it "converts fractional day into microseconds" $ do + I.scale 0.5 (I.MkInterval 0 1 0) `H.shouldBe` Just (I.MkInterval 0 0 43200000000) + + H.it "fails with overflow" $ do + I.scale 2 (I.MkInterval 0 1073741824 0) `H.shouldBe` Nothing + + H.describe "months" $ do + H.it "scales up" $ do + I.scale 2 (I.MkInterval 1 0 0) `H.shouldBe` Just (I.MkInterval 2 0 0) + + H.it "scales down" $ do + I.scale 0.5 (I.MkInterval 2 0 0) `H.shouldBe` Just (I.MkInterval 1 0 0) + + H.it "converts fractional month into days" $ do + I.scale 0.5 (I.MkInterval 1 0 0) `H.shouldBe` Just (I.MkInterval 0 15 0) + + H.it "converts fractional month into days and microseconds" $ do + I.scaleSaturating 0.05 (I.MkInterval 1 0 0) `H.shouldBe` I.MkInterval 0 1 43200000000 + + H.it "fails with overflow" $ do + I.scale 2 (I.MkInterval 1073741824 0 0) `H.shouldBe` Nothing + + H.describe "scaleSaturating" $ do + H.describe "microseconds" $ do + H.it "scales up" $ do + I.scaleSaturating 2 (I.MkInterval 0 0 1) `H.shouldBe` I.MkInterval 0 0 2 + + H.it "scales down" $ do + I.scaleSaturating 0.5 (I.MkInterval 0 0 2) `H.shouldBe` I.MkInterval 0 0 1 + + H.it "rounds down" $ do + I.scaleSaturating 0.4 (I.MkInterval 0 0 1) `H.shouldBe` I.MkInterval 0 0 0 + + H.it "rounds up" $ do + I.scaleSaturating 0.6 (I.MkInterval 0 0 1) `H.shouldBe` I.MkInterval 0 0 1 + + H.it "rounds half down to even" $ do + I.scaleSaturating 0.5 (I.MkInterval 0 0 1) `H.shouldBe` I.MkInterval 0 0 0 + + H.it "rounds half up to even" $ do + I.scaleSaturating 0.5 (I.MkInterval 0 0 3) `H.shouldBe` I.MkInterval 0 0 2 + + H.it "saturates with overflow" $ do + I.scaleSaturating 2 (I.MkInterval 0 0 4611686018427387904) `H.shouldBe` I.MkInterval 0 0 9223372036854775807 + + H.describe "days" $ do + H.it "scales up" $ do + I.scaleSaturating 2 (I.MkInterval 0 1 0) `H.shouldBe` I.MkInterval 0 2 0 + + H.it "scales down" $ do + I.scaleSaturating 0.5 (I.MkInterval 0 2 0) `H.shouldBe` I.MkInterval 0 1 0 + + H.it "converts fractional day into microseconds" $ do + I.scaleSaturating 0.5 (I.MkInterval 0 1 0) `H.shouldBe` I.MkInterval 0 0 43200000000 + + H.it "saturates with overflow" $ do + I.scaleSaturating 2 (I.MkInterval 0 1073741824 0) `H.shouldBe` I.MkInterval 0 2147483647 0 + + H.describe "months" $ do + H.it "scales up" $ do + I.scaleSaturating 2 (I.MkInterval 1 0 0) `H.shouldBe` I.MkInterval 2 0 0 + + H.it "scales down" $ do + I.scaleSaturating 0.5 (I.MkInterval 2 0 0) `H.shouldBe` I.MkInterval 1 0 0 + + H.it "converts fractional month into days" $ do + I.scaleSaturating 0.5 (I.MkInterval 1 0 0) `H.shouldBe` I.MkInterval 0 15 0 + + H.it "converts fractional month into days and microseconds" $ do + I.scaleSaturating 0.05 (I.MkInterval 1 0 0) `H.shouldBe` I.MkInterval 0 1 43200000000 + + H.it "saturates with overflow" $ do + I.scaleSaturating 2 (I.MkInterval 1073741824 0 0) `H.shouldBe` I.MkInterval 2147483647 0 0 + H.describe "render" $ do H.it "works with zero" $ do let actual = Builder.toLazyByteString $ I.render I.zero