diff --git a/README.md b/README.md index 35bd102..441a9b8 100644 --- a/README.md +++ b/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` diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs index a2ea259..f1c3074 100644 --- a/lib/Database/PostgreSQL/Opium/FromField.hs +++ b/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 - where - fromJulianDay x = addDays (fromIntegral x) postgresEpoch + parseField = fromPostgresJulian . fromIntegral <$> intParser @Int32 -- | 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 diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs index 4ec28c0..a09a733 100644 --- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs +++ b/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 0 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0) - shouldFetch conn "SELECT timestamp 'January 1, 1 BC 00:00:00' AS utctime" [AUTCTime ts3] - -} + let ts3 = UTCTime (fromGregorian (-4710) 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0) + shouldFetch conn "SELECT timestamp 'January 1, 4710 BC 00:00:00' AS utctime" [AUTCTime ts3] describe "FromField RawField" $ do it "Simply returns the bytestring without decoding it" $ \conn -> do