diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs index 5036c8b..a2ea259 100644 --- a/lib/Database/PostgreSQL/Opium/FromField.hs +++ b/lib/Database/PostgreSQL/Opium/FromField.hs @@ -20,6 +20,9 @@ import Data.Time ( Day (..) , DiffTime , TimeOfDay + , UTCTime (..) + , addDays + , fromGregorian , picosecondsToDiffTime , timeToTimeOfDay ) @@ -123,13 +126,16 @@ instance FromField Bool where validOid Proxy = Oid.boolean parseField = boolParser +postgresEpoch :: Day +postgresEpoch = fromGregorian 2000 1 1 + -- | 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 . fromIntegral <$> intParser @Int32 + parseField = fromJulianDay <$> intParser @Int32 where - fromJulianDay x = ModifiedJulianDay $ x + 51544 + 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. @@ -148,6 +154,19 @@ instance FromField TimeOfDay where validOid Proxy = Oid.time parseField = timeToTimeOfDay <$> parseField @DiffTime +instance FromField UTCTime where + validOid Proxy = Oid.timestamp + parseField = fromPostgresTimestamp <$> intParser @Int + where + fromPostgresTimestamp :: Int -> UTCTime + fromPostgresTimestamp ts = + let + (days, microseconds) = ts `divMod` (86400 * 1000000) + day = addDays (fromIntegral days) postgresEpoch + time = picosecondsToDiffTime $ fromIntegral microseconds * 1000000 + in + UTCTime day time + newtype RawField a = RawField a deriving (Eq, Show) diff --git a/lib/Database/PostgreSQL/Opium/Oid.hs b/lib/Database/PostgreSQL/Opium/Oid.hs index d0feab2..e81205a 100644 --- a/lib/Database/PostgreSQL/Opium/Oid.hs +++ b/lib/Database/PostgreSQL/Opium/Oid.hs @@ -56,3 +56,7 @@ date = eq $ Oid 1082 -- | Time of day. time :: Oid -> Bool time = eq $ Oid 1083 + +-- | A point in time. +timestamp :: Oid -> Bool +timestamp = eq $ Oid 1114 diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs index 436ff62..4ec28c0 100644 --- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs +++ b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs @@ -4,7 +4,15 @@ module Database.PostgreSQL.Opium.FromFieldSpec (spec) where import Data.ByteString (ByteString) -import Data.Time (Day (..), DiffTime, TimeOfDay (..), fromGregorian, secondsToDiffTime) +import Data.Time + ( Day (..) + , DiffTime + , TimeOfDay (..) + , UTCTime (..) + , fromGregorian + , secondsToDiffTime + , timeOfDayToTime + ) import Data.Text (Text) import Database.PostgreSQL.LibPQ (Connection) import Database.PostgreSQL.Opium (FromRow) @@ -93,6 +101,12 @@ newtype ATimeOfDay = ATimeOfDay instance FromRow ATimeOfDay where +newtype AUTCTime = AUTCTime + { utctime :: UTCTime + } deriving (Eq, Generic, Show) + +instance FromRow AUTCTime where + newtype ARawField = ARawField { raw :: Opium.RawField ByteString } deriving (Eq, Generic, Show) @@ -247,6 +261,22 @@ spec = do shouldFetch conn "SELECT time '00:01:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 1 0] shouldFetch conn "SELECT time '13:07:43' AS timeofday" [ATimeOfDay $ TimeOfDay 13 7 43] + describe "FromField UTCTime" $ do + it "Decodes timestamp" $ \conn -> do + let ts0 = UTCTime (fromGregorian 2023 10 2) (timeOfDayToTime $ TimeOfDay 12 42 23) + shouldFetch conn "SELECT timestamp '2023-10-02 12:42:23' AS utctime" [AUTCTime ts0] + + let ts1 = UTCTime (fromGregorian 294275 12 31) (timeOfDayToTime $ TimeOfDay 23 59 59) + shouldFetch conn "SELECT timestamp '294275-12-31 23:59:59' AS utctime" [AUTCTime ts1] + + 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] + -} + describe "FromField RawField" $ do it "Simply returns the bytestring without decoding it" $ \conn -> do shouldFetch conn "SELECT 'Hello, World!'::bytea AS raw" [ARawField $ Opium.RawField "Hello, World!"]