From aae65548f9d57ba68f9590f70b1f9179e4443d99 Mon Sep 17 00:00:00 2001 From: Nebula Lavelle Date: Sat, 9 Nov 2024 11:20:57 -0500 Subject: [PATCH] Supports negative years for date and timestamp types Previously we were ISO8601 encoding/decoding dates and timestamps with negative years, however PostgreSQL uses a "BC" suffix to indicate negative years. I added support for this syntax to the `Day`, `UTCTime`, and `LocalTime` `SqlType`s, and expanded the range of years generated in testing to ensure we're handling the negative years correctly. --- .../PostgreSQL/Marshall/FieldDefinition.hs | 12 +++ .../Orville/PostgreSQL/Marshall/SqlType.hs | 12 +++ .../src/Orville/PostgreSQL/Raw/PgTime.hs | 95 +++++++++++++++++-- orville-postgresql/test/Test/PgGen.hs | 2 +- 4 files changed, 111 insertions(+), 10 deletions(-) diff --git a/orville-postgresql/src/Orville/PostgreSQL/Marshall/FieldDefinition.hs b/orville-postgresql/src/Orville/PostgreSQL/Marshall/FieldDefinition.hs index b73f3cd6..2354537c 100644 --- a/orville-postgresql/src/Orville/PostgreSQL/Marshall/FieldDefinition.hs +++ b/orville-postgresql/src/Orville/PostgreSQL/Marshall/FieldDefinition.hs @@ -608,6 +608,10 @@ jsonbField = fieldOfType SqlType.jsonb {- | Builds a 'FieldDefinition' that stores Haskell 'Time.Day' values as the PostgreSQL "DATE" type. + This field cannot represent the full range of 'Time.Day' values. PostgreSQL supports years + from -4731 to 5874897 inclusive for this field, and sending a 'Time.Day' with a year outside + of this range to the database will result in a PostgreSQL exception. + @since 1.0.0.0 -} dateField :: @@ -619,6 +623,10 @@ dateField = fieldOfType SqlType.date {- | Builds a 'FieldDefinition' that stores Haskell 'Time.UTCTime' values as the PostgreSQL "TIMESTAMP with time zone" type. + This field cannot represent the full range of 'Time.UTCTime' values. PostgreSQL supports years + from -4731 to 294276 inclusive for this field, and sending a 'Time.UTCTime' with a year outside + of this range to the database will result in a PostgreSQL exception. + @since 1.0.0.0 -} utcTimestampField :: @@ -630,6 +638,10 @@ utcTimestampField = fieldOfType SqlType.timestamp {- | Builds a 'FieldDefinition' that stores Haskell 'Time.UTCTime' values as the PostgreSQL "TIMESTAMP without time zone" type. + This field cannot represent the full range of 'Time.LocalTime' values. PostgreSQL supports years + from -4731 to 294276 inclusive for this field, and sending a 'Time.LocalTime' with a year outside + of this range to the database will result in a PostgreSQL exception. + @since 1.0.0.0 -} localTimestampField :: diff --git a/orville-postgresql/src/Orville/PostgreSQL/Marshall/SqlType.hs b/orville-postgresql/src/Orville/PostgreSQL/Marshall/SqlType.hs index b3838317..48d13b14 100644 --- a/orville-postgresql/src/Orville/PostgreSQL/Marshall/SqlType.hs +++ b/orville-postgresql/src/Orville/PostgreSQL/Marshall/SqlType.hs @@ -309,6 +309,10 @@ uuid = {- | 'date' defines a type representing a calendar date (without time zone). It corresponds to the "DATE" type in SQL. + This type cannot represent the full range of 'Time.Day' values. PostgreSQL supports years + from -4731 to 5874897 inclusive for this type, and sending a 'Time.Day' with a year outside + of this range to the database will result in a PostgreSQL exception. + @since 1.0.0.0 -} date :: SqlType Time.Day @@ -327,6 +331,10 @@ date = but can be constructed with a time zone offset. It corresponds to the "TIMESTAMP with time zone" type in SQL. + This type cannot represent the full range of 'Time.UTCTime' values. PostgreSQL supports years + from -4731 to 294276 inclusive for this type, and sending a 'Time.UTCTime' with a year outside + of this range to the database will result in a PostgreSQL exception. + Note: This is NOT a typo. The "TIMESTAMP with time zone" type in SQL does not include any actual time zone information. For an excellent explanation of the complexities involving this type, please see Chris Clark's blog post about it: @@ -349,6 +357,10 @@ timestamp = {- | 'timestampWithoutZone' defines a type representing a particular point in time (without time zone). It corresponds to the "TIMESTAMP without time zone" type in SQL. + This type cannot represent the full range of 'Time.LocalTime' values. PostgreSQL supports years + from -4731 to 294276 inclusive for this type, and sending a 'Time.LocalTime' with a year outside + of this range to the database will result in a PostgreSQL exception. + http://blog.untrod.com/2016/08/actually-understanding-timezones-in-postgresql.html @since 1.0.0.0 diff --git a/orville-postgresql/src/Orville/PostgreSQL/Raw/PgTime.hs b/orville-postgresql/src/Orville/PostgreSQL/Raw/PgTime.hs index 2c0a10c0..a669f41a 100644 --- a/orville-postgresql/src/Orville/PostgreSQL/Raw/PgTime.hs +++ b/orville-postgresql/src/Orville/PostgreSQL/Raw/PgTime.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveFunctor #-} + {- | Copyright : Flipstone Technology Partners 2023 License : MIT @@ -15,6 +17,7 @@ module Orville.PostgreSQL.Raw.PgTime ) where +import Control.Applicative (optional) import qualified Data.Attoparsec.ByteString as AttoBS import qualified Data.Attoparsec.ByteString.Char8 as AttoB8 import qualified Data.ByteString as BS @@ -29,8 +32,33 @@ import qualified Data.Word as Word @since 1.0.0.0 -} dayToPostgreSQL :: Time.Day -> B8.ByteString -dayToPostgreSQL = - B8.pack . Time.showGregorian +dayToPostgreSQL date = + B8.pack $ + case absDayYear date of + NegativeYear absDate -> Time.showGregorian absDate <> " BC" + PositiveYear _ -> Time.showGregorian date + +data AbsYearResult a + = NegativeYear a + | PositiveYear a + deriving (Functor) + +absDayYear :: Time.Day -> AbsYearResult Time.Day +absDayYear date = + let + (y, m, d) = Time.toGregorian date + absDay = Time.fromGregorian (abs y) m d + in + if y < 0 + then NegativeYear absDay + else PositiveYear absDay + +negateDayYear :: Time.Day -> Time.Day +negateDayYear date = + let + (y, m, d) = Time.toGregorian date + in + Time.fromGregorian (negate y) m d {- | An Attoparsec parser for parsing 'Time.Day' from YYYY-MM-DD format. Parsing fails if given an invalid 'Time.Day'. @@ -45,7 +73,16 @@ day = do else do m <- twoDigits <* AttoB8.char '-' d <- twoDigits - maybe (fail "invalid date format") pure $ Time.fromGregorianValid y m d + mbBc <- optionalBC + let + negateFn = maybe id (const negateDayYear) mbBc + maybe + (fail "invalid date format") + (pure . negateFn) + (Time.fromGregorianValid y m d) + +optionalBC :: AttoB8.Parser (Maybe B8.ByteString) +optionalBC = optional . AttoB8.string $ B8.pack " BC" {- | An Attoparsec parser for parsing 2-digit integral numbers. @@ -65,8 +102,14 @@ fromChar c = fromIntegral $ Char.ord c - Char.ord '0' @since 1.0.0.0 -} utcTimeToPostgreSQL :: Time.UTCTime -> B8.ByteString -utcTimeToPostgreSQL = - B8.pack . Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d %H:%M:%S%Q+00" +utcTimeToPostgreSQL time = + let + format = Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d %H:%M:%S%Q+00" + in + B8.pack $ + case absUtcTimeYear time of + NegativeYear absTime -> format absTime <> " BC" + PositiveYear _ -> format time {- | An Attoparsec parser for parsing 'Time.UTCTime' from an ISO-8601 style datetime and timezone with a few PostgreSQL-specific exceptions. See @@ -84,21 +127,53 @@ utcTime = do hour <- twoDigits minute <- AttoB8.option 0 $ AttoB8.choice [AttoB8.char ':' *> twoDigits, twoDigits] second <- AttoB8.option 0 $ AttoB8.char ':' *> twoDigits + mbBc <- optionalBC let + negateFn = maybe id (const negateUtcTimeYear) mbBc offsetSeconds :: Int offsetSeconds = (second + minute * 60 + hour * 3600) * if sign == '+' then (-1) else 1 offsetNominalDiffTime = fromIntegral offsetSeconds diffTime = Time.timeOfDayToTime (Time.localTimeOfDay lt) utcTimeWithoutOffset = Time.UTCTime (Time.localDay lt) diffTime - pure $ Time.addUTCTime offsetNominalDiffTime utcTimeWithoutOffset + pure . negateFn $ Time.addUTCTime offsetNominalDiffTime utcTimeWithoutOffset + +absUtcTimeYear :: Time.UTCTime -> AbsYearResult Time.UTCTime +absUtcTimeYear time = + fmap + (`Time.UTCTime` Time.utctDayTime time) + (absDayYear $ Time.utctDay time) + +negateUtcTimeYear :: Time.UTCTime -> Time.UTCTime +negateUtcTimeYear time = + Time.UTCTime + (negateDayYear $ Time.utctDay time) + (Time.utctDayTime time) {- | Renders a 'Time.LocalTime' value to a textual representation for PostgreSQL. @since 1.0.0.0 -} localTimeToPostgreSQL :: Time.LocalTime -> B8.ByteString -localTimeToPostgreSQL = - B8.pack . Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d %H:%M:%S%Q" +localTimeToPostgreSQL time = + let + format = Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d %H:%M:%S%Q" + in + B8.pack $ + case absLocalTimeYear time of + NegativeYear absTime -> format absTime <> " BC" + PositiveYear _ -> format time + +absLocalTimeYear :: Time.LocalTime -> AbsYearResult Time.LocalTime +absLocalTimeYear time = + fmap + (`Time.LocalTime` Time.localTimeOfDay time) + (absDayYear $ Time.localDay time) + +negateLocalTimeYear :: Time.LocalTime -> Time.LocalTime +negateLocalTimeYear time = + Time.LocalTime + (negateDayYear $ Time.localDay time) + (Time.localTimeOfDay time) {- | An Attoparsec parser for parsing 'Time.LocalTime' from an ISO-8601 style datetime with a few exceptions. The separator between the date and time @@ -108,7 +183,9 @@ localTimeToPostgreSQL = -} localTime :: AttoB8.Parser Time.LocalTime localTime = do - Time.LocalTime <$> day <* AttoB8.char ' ' <*> timeOfDay + time <- Time.LocalTime <$> day <* AttoB8.char ' ' <*> timeOfDay + mbBc <- optionalBC + pure $ maybe id (const negateLocalTimeYear) mbBc time {- | An Attoparsec parser for parsing 'Time.TimeOfDay' from an ISO-8601 style time. diff --git a/orville-postgresql/test/Test/PgGen.hs b/orville-postgresql/test/Test/PgGen.hs index cd5c1b0e..edbd0511 100644 --- a/orville-postgresql/test/Test/PgGen.hs +++ b/orville-postgresql/test/Test/PgGen.hs @@ -125,7 +125,7 @@ pgLocalTime = pgDay :: HH.Gen Time.Day pgDay = do - year <- Gen.integral (Range.linearFrom 2000 0 3000) + year <- Gen.integral (Range.constant (-4713) 294276) month <- Gen.integral (Range.constant 1 12) day <- Gen.integral (Range.constant 1 (Time.gregorianMonthLength year month))