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.10 +version: 0.2025.7.11 synopsis: A simple interval type for PostgreSQL. description: This library provides a simple interval type for PostgreSQL. It supports @@ -25,8 +25,8 @@ common library build-depends: attoparsec ^>=0.14.4, - base ^>={4.19, 4.20, 4.21}, - bytestring ^>=0.12.1, + base >=4.13 && <4.22, + bytestring >=0.10.10 && <0.13, default-language: Haskell2010 ghc-options: @@ -35,12 +35,18 @@ -Wno-implicit-prelude -Wno-missing-deriving-strategies -Wno-missing-export-lists - -Wno-missing-kind-signatures - -Wno-missing-safe-haskell-mode - -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe + if impl(ghc >=8.10) + ghc-options: + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + + if impl(ghc >=9.2) + ghc-options: + -Wno-missing-kind-signatures + if flag(pedantic) ghc-options: -Werror @@ -54,8 +60,10 @@ library 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 @@ -1,4 +1,3 @@ -{-# LANGUAGE LexicalNegation #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-} @@ -10,9 +9,14 @@ 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 @@ -26,11 +30,11 @@ -- 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 a @NominalDiffTime@. Is --- not bounded. --- - @CalendarDiffDays@: Does not handle seconds. Is not bounded. +-- - '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. data Interval = MkInterval { months :: !Int.Int32, days :: !Int.Int32, @@ -43,10 +47,35 @@ fromField = Postgres.attoFieldParser (== Postgres.intervalOid) parse -- | Uses 'render'. Always includes an @interval@ prefix, like --- @interval '2 months 3 days 4 microseconds'@. +-- @interval '\@ 0 mon -1 day +2 us'@. instance Postgres.ToField Interval where - toField = Postgres.Plain . ("interval " <>) . Postgres.inQuotes . render + toField = Postgres.Plain . ("interval '" <>) . (<> "'") . render +-- | Behaves the same as the 'Postgres.FromField' and 'Postgres.ToField' +-- instances. +instance Persist.PersistField Interval where + fromPersistValue persistValue = case persistValue of + Persist.PersistLiteralEscaped byteString + | Right interval <- A.parseOnly parse byteString -> + Right interval + Persist.PersistLiteral byteString + | Just withoutPrefix <- Ascii.stripPrefix "interval '" byteString, + Just withoutSuffix <- Ascii.stripSuffix "'" withoutPrefix, + Right interval <- A.parseOnly parse withoutSuffix -> + Right interval + _ -> Left $ "Invalid interval: " <> Text.pack (show persistValue) + toPersistValue = + Persist.PersistLiteral + . LazyByteString.toStrict + . Builder.toLazyByteString + . ("interval '" <>) + . (<> "'") + . render + +-- | @'Persist.SqlOther' "interval"@ +instance Persist.PersistFieldSql Interval where + sqlType = const $ Persist.SqlOther "interval" + -- | The empty interval, representing no time at all. -- -- >>> zero @@ -336,13 +365,13 @@ negateComponent :: Component -> Component negateComponent c = case c of - Years y -> Years -y - Months m -> Months -m - Days d -> Days -d - Hours h -> Hours -h - Minutes m -> Minutes -m - Seconds u -> Seconds -u - Microseconds u -> Microseconds -u + Years y -> Years (-y) + Months m -> Months (-m) + Days d -> Days (-d) + Hours h -> Hours (-h) + Minutes m -> Minutes (-m) + Seconds u -> Seconds (-u) + Microseconds u -> Microseconds (-u) negateComponentsWhen :: (Functor f) => Bool -> f Component -> f Component negateComponentsWhen p = if p then fmap negateComponent else id 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,4 +1,3 @@ -{-# LANGUAGE LexicalNegation #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-} @@ -30,7 +29,7 @@ actual `H.shouldBe` Nothing H.it "fails with negative month overflow" $ do - let actual = I.add (I.fromMonths minBound) (I.fromMonths -1) + let actual = I.add (I.fromMonths minBound) (I.fromMonths (-1)) actual `H.shouldBe` Nothing H.it "fails with positive day overflow" $ do @@ -38,7 +37,7 @@ actual `H.shouldBe` Nothing H.it "fails with negative day overflow" $ do - let actual = I.add (I.fromDays minBound) (I.fromDays -1) + let actual = I.add (I.fromDays minBound) (I.fromDays (-1)) actual `H.shouldBe` Nothing H.it "fails with positive microsecond overflow" $ do @@ -46,7 +45,7 @@ actual `H.shouldBe` Nothing H.it "fails with negative microsecond overflow" $ do - let actual = I.add (I.fromMicroseconds minBound) (I.fromMicroseconds -1) + let actual = I.add (I.fromMicroseconds minBound) (I.fromMicroseconds (-1)) actual `H.shouldBe` Nothing H.describe "fromMicroseconds" $ do @@ -113,7 +112,7 @@ actual `H.shouldBe` "@ +1 mon +2 day +3 us" H.it "works with negative components" $ do - let actual = Builder.toLazyByteString . I.render $ I.MkInterval -3 -2 -1 + let actual = Builder.toLazyByteString . I.render $ I.MkInterval (-3) (-2) (-1) actual `H.shouldBe` "@ -3 mon -2 day -1 us" H.describe "parse" $ do @@ -190,36 +189,36 @@ examples = [ mkExample 0 0 0 "PT0S" "00:00:00" "@ 0" "0", mkExample 1 0 0 "P1M" "1 mon" "@ 1 mon" "0-1", - mkExample -1 0 0 "P-1M" "-1 mons" "@ 1 mon ago" "-0-1", + mkExample (-1) 0 0 "P-1M" "-1 mons" "@ 1 mon ago" "-0-1", mkExample 3 0 0 "P3M" "3 mons" "@ 3 mons" "0-3", mkExample 6 0 0 "P6M" "6 mons" "@ 6 mons" "0-6", mkExample 12 0 0 "P1Y" "1 year" "@ 1 year" "1-0", - mkExample -12 0 0 "P-1Y" "-1 years" "@ 1 year ago" "-1-0", + mkExample (-12) 0 0 "P-1Y" "-1 years" "@ 1 year ago" "-1-0", mkExample 13 0 0 "P1Y1M" "1 year 1 mon" "@ 1 year 1 mon" "1-1", - mkExample -13 0 0 "P-1Y-1M" "-1 years -1 mons" "@ 1 year 1 mon ago" "-1-1", + mkExample (-13) 0 0 "P-1Y-1M" "-1 years -1 mons" "@ 1 year 1 mon ago" "-1-1", mkExample 24 0 0 "P2Y" "2 years" "@ 2 years" "2-0", mkExample 0 1 0 "P1D" "1 day" "@ 1 day" "1 0:00:00", - mkExample 0 -1 0 "P-1D" "-1 days" "@ 1 day ago" "-1 0:00:00", + mkExample 0 (-1) 0 "P-1D" "-1 days" "@ 1 day ago" "-1 0:00:00", mkExample 0 2 0 "P2D" "2 days" "@ 2 days" "2 0:00:00", mkExample 0 7 0 "P7D" "7 days" "@ 7 days" "7 0:00:00", mkExample 0 0 1 "PT0.000001S" "00:00:00.000001" "@ 0.000001 secs" "0:00:00.000001", - mkExample 0 0 -1 "PT-0.000001S" "-00:00:00.000001" "@ 0.000001 secs ago" "-0:00:00.000001", + mkExample 0 0 (-1) "PT-0.000001S" "-00:00:00.000001" "@ 0.000001 secs ago" "-0:00:00.000001", mkExample 0 0 1e3 "PT0.001S" "00:00:00.001" "@ 0.001 secs" "0:00:00.001", mkExample 0 0 1e6 "PT1S" "00:00:01" "@ 1 sec" "0:00:01", - mkExample 0 0 -1e6 "PT-1S" "-00:00:01" "@ 1 sec ago" "-0:00:01", + mkExample 0 0 (-1e6) "PT-1S" "-00:00:01" "@ 1 sec ago" "-0:00:01", mkExample 0 0 2e6 "PT2S" "00:00:02" "@ 2 secs" "0:00:02", mkExample 0 0 60e6 "PT1M" "00:01:00" "@ 1 min" "0:01:00", - mkExample 0 0 -60e6 "PT-1M" "-00:01:00" "@ 1 min ago" "-0:01:00", + mkExample 0 0 (-60e6) "PT-1M" "-00:01:00" "@ 1 min ago" "-0:01:00", mkExample 0 0 120e6 "PT2M" "00:02:00" "@ 2 mins" "0:02:00", mkExample 0 0 3600e6 "PT1H" "01:00:00" "@ 1 hour" "01:00:00", - mkExample 0 0 -3600e6 "PT-1H" "-01:00:00" "@ 1 hour ago" "-01:00:00", + mkExample 0 0 (-3600e6) "PT-1H" "-01:00:00" "@ 1 hour ago" "-01:00:00", mkExample 0 0 7200e6 "PT2H" "02:00:00" "@ 2 hours" "02:00:00", mkExample 0 0 86400e6 "PT24H" "24:00:00" "@ 24 hours" "24:00:00", mkExample 1 1 1e6 "P1M1DT1S" "1 mon 1 day 00:00:01" "@ 1 mon 1 day 1 sec" "+0-1 +1 +0:00:01", - mkExample -1 -1 -1e6 "P-1M-1DT-1S" "-1 mons -1 days -00:00:01" "@ 1 mon 1 day 1 sec ago" "-0-1 -1 -0:00:01", - mkExample -1 1 1e6 "P-1M1DT1S" "-1 mons +1 day 00:00:01" "@ 1 mon -1 days -1 sec ago" "-0-1 +1 +0:00:01", - mkExample 1 -1 1e6 "P1M-1DT1S" "1 mon -1 days +00:00:01" "@ 1 mon -1 days 1 sec" "+0-1 -1 +0:00:01", - mkExample 1 1 -1e6 "P1M1DT-1S" "1 mon 1 day -00:00:01" "@ 1 mon 1 day -1 sec" "+0-1 +1 -0:00:01", + mkExample (-1) (-1) (-1e6) "P-1M-1DT-1S" "-1 mons -1 days -00:00:01" "@ 1 mon 1 day 1 sec ago" "-0-1 -1 -0:00:01", + mkExample (-1) 1 1e6 "P-1M1DT1S" "-1 mons +1 day 00:00:01" "@ 1 mon -1 days -1 sec ago" "-0-1 +1 +0:00:01", + mkExample 1 (-1) 1e6 "P1M-1DT1S" "1 mon -1 days +00:00:01" "@ 1 mon -1 days 1 sec" "+0-1 -1 +0:00:01", + mkExample 1 1 (-1e6) "P1M1DT-1S" "1 mon 1 day -00:00:01" "@ 1 mon 1 day -1 sec" "+0-1 +1 -0:00:01", mkExample 14 3 14706000007 "P1Y2M3DT4H5M6.000007S" "1 year 2 mons 3 days 04:05:06.000007" "@ 1 year 2 mons 3 days 4 hours 5 mins 6.000007 secs" "+1-2 +3 +4:05:06.000007", mkExample maxBound 0 0 "P178956970Y7M" "178956970 years 7 mons" "@ 178956970 years 7 mons" "178956970-7", mkExample minBound 0 0 "P-178956970Y-8M" "-178956970 years -8 mons" "@ 178956970 years 8 mons ago" "-178956970-8",