Change negative days by 1 to account for missing year zero

README.md

@@ -64,10 +64,12 @@ getScoreByAge conn = do
 - [x] Clean up and document column table stuff
 - [x] Decode `LibPQ.Binary`
 - [x] Implement `date -> Day` decoding
+- [x] Implement `UTCTime`
+- [x] Implement `ByteString` decoding (`bytea`)
+- [ ] and zoned time decoding
 - [ ] Implement `fetch` (`fetch_` but with parameter passing)
-- [ ] Implement `UTCTime` and zoned time decoding
 - [ ] Implement JSON decoding
-- [ ] Implement `ByteString` decoding (`bytea`)
 - [ ] Implement (anonymous) composite types
 - [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text
 - [ ] Implement array decoding
+- [ ] Test negative integer decoding, especially for `Integer`

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -25,6 +25,7 @@ import Data.Time
   , fromGregorian
   , picosecondsToDiffTime
   , timeToTimeOfDay
+  , toGregorian
   )
 import Data.Text (Text)
 import Data.Word (Word32, Word64)
@@ -129,13 +130,19 @@ instance FromField Bool where
 postgresEpoch :: Day
 postgresEpoch = fromGregorian 2000 1 1
 
+fromPostgresJulian :: Integer -> Day
+fromPostgresJulian x
+  | year <= 0 = fromGregorian (year - 1) month dayOfMonth
+  | otherwise = day
+  where
+    day = addDays (fromIntegral x) postgresEpoch
+    (year, month, dayOfMonth) = toGregorian day
+
 -- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
 -- Relevant as well: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/datetime.c;h=267dfd37b2e8b9bc63797c69b9ca2e45e6bfde61;hb=HEAD#l267.
 instance FromField Day where
   validOid Proxy = Oid.date
-  parseField = fromJulianDay <$> intParser @Int32
+  parseField = fromPostgresJulian . fromIntegral <$> intParser @Int32
-    where
-      fromJulianDay x = addDays (fromIntegral x) postgresEpoch
 
 -- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
 -- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
@@ -162,7 +169,7 @@ instance FromField UTCTime where
       fromPostgresTimestamp ts =
         let
           (days, microseconds) = ts `divMod` (86400 * 1000000)
-          day = addDays (fromIntegral days) postgresEpoch
+          day = fromPostgresJulian $ fromIntegral days
           time = picosecondsToDiffTime $ fromIntegral microseconds * 1000000
         in
           UTCTime day time

test/Database/PostgreSQL/Opium/FromFieldSpec.hs

@@ -249,6 +249,11 @@ spec = do
       -- Example from postgres doc page
       shouldFetch conn "SELECT date 'J2451187' AS day" [ADay $ fromGregorian 1999 1 8]
 
+      -- BC
+      -- See https://www.postgresql.org/docs/current/datetime-input-rules.html:
+      -- "If BC has been specified, negate the year and add one for internal storage. (There is no year zero in the Gregorian calendar, so numerically 1 BC becomes year zero.)"
+      shouldFetch conn "SELECT date 'January 1, 4710 BC' AS day" [ADay $ fromGregorian (-4710) 1 1]
+
   describe "FromField DiffTime" $ do
     it "Decodes the time" $ \conn -> do
       shouldFetch conn "SELECT time '00:00:00' AS difftime" [ADiffTime 0]
@@ -272,10 +277,8 @@ spec = do
       let ts2 = UTCTime (fromGregorian 1 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0)
       shouldFetch conn "SELECT timestamp '0001-01-01 00:00:00' AS utctime" [AUTCTime ts2]
 
-      {- TODO: How does "BC" work here?
+      let ts3 = UTCTime (fromGregorian (-4710) 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0)
-      let ts3 = UTCTime (fromGregorian 0 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0)
+      shouldFetch conn "SELECT timestamp 'January 1, 4710 BC 00:00:00' AS utctime" [AUTCTime ts3]
-      shouldFetch conn "SELECT timestamp 'January 1, 1 BC 00:00:00' AS utctime" [AUTCTime ts3]
-      -}
 
   describe "FromField RawField" $ do
     it "Simply returns the bytestring without decoding it" $ \conn -> do