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.7.11 +version: 0.2025.7.12 synopsis: A simple interval type for PostgreSQL. description: This library provides a simple interval type for PostgreSQL. It supports @@ -27,6 +27,8 @@ attoparsec ^>=0.14.4, 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: @@ -61,9 +63,7 @@ import: library build-depends: persistent ^>=2.17, - postgresql-simple ^>=0.7, scientific ^>=0.3.8, - text >=1.2.4 && <1.3 || >=2.0 && <2.2, -- cabal-gild: discover source/library exposed-modules: 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 @@ -35,6 +35,12 @@ -- - '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: +-- data Interval = MkInterval { months :: !Int.Int32, days :: !Int.Int32, @@ -47,7 +53,7 @@ fromField = Postgres.attoFieldParser (== Postgres.intervalOid) parse -- | Uses 'render'. Always includes an @interval@ prefix, like --- @interval '\@ 0 mon -1 day +2 us'@. +-- @interval '...'@. instance Postgres.ToField Interval where toField = Postgres.Plain . ("interval '" <>) . (<> "'") . render @@ -204,24 +210,34 @@ <*> Function.on safeAdd microseconds x y -- | Renders an interval to a 'Builder'. This always has the same format: --- @"\@ X mon Y day Z us"@, where @X@, @Y@, and @Z@ are signed integers. +-- @"\@ 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 +2 us" +-- "@ 0 mon -1 day 0 hour 0 min 0 sec +2 us" render :: Interval -> Builder.Builder render x = let signed :: (Num a, Ord a) => (a -> Builder.Builder) -> a -> Builder.Builder signed f n = (if n > 0 then "+" else "") <> f n + (t1, u) = quotRem (microseconds x) 1000000 + (t2, s) = quotRem t1 60 + (h, m) = quotRem t2 60 in "@ " <> signed Builder.int32Dec (months x) <> " mon " <> signed Builder.int32Dec (days x) <> " day " - <> signed Builder.int64Dec (microseconds x) + <> signed Builder.int64Dec h + <> " hour " + <> signed Builder.int64Dec m + <> " min " + <> signed Builder.int64Dec s + <> " sec " + <> signed Builder.int64Dec u <> " us" -- | Parses an interval. This is not a general purpose parser. It only supports 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 @@ -1,14 +1,19 @@ {-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-} +import qualified Control.Exception as Exception import qualified Control.Monad as Monad import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec import qualified Data.ByteString as ByteString 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 Database.PostgreSQL.Simple 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 @@ -105,16 +110,20 @@ H.describe "render" $ do H.it "works with zero" $ do let actual = Builder.toLazyByteString $ I.render I.zero - actual `H.shouldBe` "@ 0 mon 0 day 0 us" + actual `H.shouldBe` "@ 0 mon 0 day 0 hour 0 min 0 sec 0 us" H.it "works with positive components" $ do let actual = Builder.toLazyByteString . I.render $ I.MkInterval 1 2 3 - actual `H.shouldBe` "@ +1 mon +2 day +3 us" + actual `H.shouldBe` "@ +1 mon +2 day 0 hour 0 min 0 sec +3 us" H.it "works with negative components" $ do let actual = Builder.toLazyByteString . I.render $ I.MkInterval (-3) (-2) (-1) - actual `H.shouldBe` "@ -3 mon -2 day -1 us" + actual `H.shouldBe` "@ -3 mon -2 day 0 hour 0 min 0 sec -1 us" + H.it "works with time components" $ do + let actual = Builder.toLazyByteString . I.render $ I.MkInterval 0 0 3723000004 + actual `H.shouldBe` "@ 0 mon 0 day +1 hour +2 min +3 sec +4 us" + H.describe "parse" $ do H.it "fails with invalid input" $ do let actual = Attoparsec.parseOnly I.parse "invalid" @@ -143,12 +152,41 @@ let actual = Attoparsec.parseOnly I.parse input actual `H.shouldBe` Right interval + H.describe "integration" $ do + Monad.forM_ intervalStyles $ \(style, field) -> do + H.describe ("with style " <> show style) $ do + Monad.forM_ examples $ \example -> do + H.it ("round trips " <> show (field example)) $ do + Postgres.withConnect Postgres.defaultConnectInfo $ \connection -> do + let interval = exampleInterval example + result <- Exception.try . Postgres.withTransaction connection $ do + Monad.void $ Postgres.execute connection "set local intervalstyle = ?" [style] + Postgres.query connection "select ?" [interval] + 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) + data IntervalStyle = Iso8601 | Postgres | PostgresVerbose | SqlStandard deriving (Eq, Show) + +instance Postgres.ToField IntervalStyle where + toField style = Postgres.Plain $ case style of + Iso8601 -> "iso_8601" + Postgres -> "postgres" + PostgresVerbose -> "postgres_verbose" + SqlStandard -> "sql_standard" data Example = MkExample { exampleInterval :: I.Interval,