From 7eccd0d7783d66fd55eb23123a2e1e97690ed2d7 Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Mon, 2 Oct 2023 14:09:45 +0200
Subject: [PATCH] Add FromField DiffTime and FromField TimeOfDay

---
 lib/Database/PostgreSQL/Opium/FromField.hs    | 25 +++++++++++++++++-
 lib/Database/PostgreSQL/Opium/Oid.hs          |  4 +++
 .../PostgreSQL/Opium/FromFieldSpec.hs         | 26 ++++++++++++++++++-
 3 files changed, 53 insertions(+), 2 deletions(-)

diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs
index 94e8006..22218e0 100644
--- a/lib/Database/PostgreSQL/Opium/FromField.hs
+++ b/lib/Database/PostgreSQL/Opium/FromField.hs
@@ -16,7 +16,13 @@ import Data.ByteString (ByteString)
 import Data.Functor (($>))
 import Data.Int (Int32)
 import Data.Proxy (Proxy (..))
-import Data.Time (Day (..))
+import Data.Time
+  ( Day (..)
+  , DiffTime
+  , TimeOfDay
+  , picosecondsToDiffTime
+  , timeToTimeOfDay
+  )
 import Data.Text (Text)
 import Data.Word (Word32, Word64)
 import Database.PostgreSQL.LibPQ (Oid)
@@ -125,6 +131,23 @@ instance FromField Day where
     where
       fromJulianDay x = ModifiedJulianDay $ x + 51544
 
+-- | 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.
+-- Accepts @time@.
+instance FromField DiffTime where
+  validOid Proxy = Oid.time
+  parseField = microsecondsToDiffTime <$> intParser
+    where
+      microsecondsToDiffTime :: Integer -> DiffTime
+      microsecondsToDiffTime ms = picosecondsToDiffTime $ ms * 1000000
+
+-- | 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.
+-- Accepts @time@.
+instance FromField TimeOfDay where
+  validOid Proxy = Oid.time
+  parseField = timeToTimeOfDay <$> parseField @DiffTime
+
 newtype RawField = RawField ByteString
   deriving (Eq, Show)
 
diff --git a/lib/Database/PostgreSQL/Opium/Oid.hs b/lib/Database/PostgreSQL/Opium/Oid.hs
index 88ea207..d0feab2 100644
--- a/lib/Database/PostgreSQL/Opium/Oid.hs
+++ b/lib/Database/PostgreSQL/Opium/Oid.hs
@@ -52,3 +52,7 @@ boolean = eq $ Oid 16
 -- | Single days/dates.
 date :: Oid -> Bool
 date = eq $ Oid 1082
+
+-- | Time of day.
+time :: Oid -> Bool
+time = eq $ Oid 1083
diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs
index 945b71c..2ec14ff 100644
--- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs
+++ b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs
@@ -4,7 +4,7 @@
 module Database.PostgreSQL.Opium.FromFieldSpec (spec) where
 
 import Data.ByteString (ByteString)
-import Data.Time (Day (..), fromGregorian)
+import Data.Time (Day (..), DiffTime, TimeOfDay (..), fromGregorian, secondsToDiffTime)
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ (Connection)
 import Database.PostgreSQL.Opium (FromRow)
@@ -81,6 +81,18 @@ newtype ADay = ADay
 
 instance FromRow ADay where
 
+newtype ADiffTime = ADiffTime
+  { difftime :: DiffTime
+  } deriving (Eq, Generic, Show)
+
+instance FromRow ADiffTime where
+
+newtype ATimeOfDay = ATimeOfDay
+  { timeofday :: TimeOfDay
+  } deriving (Eq, Generic, Show)
+
+instance FromRow ATimeOfDay where
+
 newtype ARawField = ARawField
   { raw :: Opium.RawField
   } deriving (Eq, Generic, Show)
@@ -223,6 +235,18 @@ spec = do
       -- Example from postgres doc page
       shouldFetch conn "SELECT date 'J2451187' AS day" [ADay $ fromGregorian 1999 1 8]
 
+  describe "FromField DiffTime" $ do
+    it "Decodes the time" $ \conn -> do
+      shouldFetch conn "SELECT time '00:00:00' AS difftime" [ADiffTime 0]
+      shouldFetch conn "SELECT time '00:01:00' AS difftime" [ADiffTime $ secondsToDiffTime 60]
+      shouldFetch conn "SELECT time '13:07:43' AS difftime" [ADiffTime $ secondsToDiffTime $ 13 * 3600 + 7 * 60 + 43]
+
+  describe "FromField TimeOfDay" $ do
+    it "Decodes the time" $ \conn -> do
+      shouldFetch conn "SELECT time '00:00:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 0 0]
+      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 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!"]