Skip to content

Commit

Permalink
Supports negative years for date and timestamp types
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
jlavelle committed Nov 9, 2024
1 parent e0ef4af commit aae6554
Show file tree
Hide file tree
Showing 4 changed files with 111 additions and 10 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -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 ::
Expand All @@ -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 ::
Expand All @@ -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 ::
Expand Down
12 changes: 12 additions & 0 deletions orville-postgresql/src/Orville/PostgreSQL/Marshall/SqlType.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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:
Expand All @@ -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
Expand Down
95 changes: 86 additions & 9 deletions orville-postgresql/src/Orville/PostgreSQL/Raw/PgTime.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
{-# LANGUAGE DeriveFunctor #-}

{- |
Copyright : Flipstone Technology Partners 2023
License : MIT
Expand All @@ -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
Expand All @@ -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'.
Expand All @@ -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.
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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.
Expand Down
2 changes: 1 addition & 1 deletion orville-postgresql/test/Test/PgGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))

Expand Down

0 comments on commit aae6554

Please sign in to comment.