Supports negative years for date and timestamp types

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 ::

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

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.
 

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.constantFrom 2000 (-4713) 294276)
   month <- Gen.integral (Range.constant 1 12)
   day <- Gen.integral (Range.constant 1 (Time.gregorianMonthLength year month))