Implement FromField UTCTime

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)
 

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