Add ToField Day

lib/Database/PostgreSQL/Opium/ToField.hs

@@ -7,8 +7,10 @@ module Database.PostgreSQL.Opium.ToField
 
 import Data.Bits (Bits (..))
 import Data.ByteString (ByteString)
+import Data.Int (Int32)
 import Data.List (singleton)
 import Data.Text (Text)
+import Data.Time (Day, diffDays, fromGregorian)
 import Data.Word (Word32)
 import Database.PostgreSQL.LibPQ (Format (..), Oid)
 import Unsafe.Coerce (unsafeCoerce)
@@ -48,3 +50,11 @@ instance ToField Float where
 
 instance ToField Double where
   toField x = Just (Oid.doublePrecision, encodeBigEndian @Word 8 $ unsafeCoerce x, Binary)
+
+toPostgresJulian :: Day -> Integer
+toPostgresJulian date = diffDays date postgresEpoch
+  where
+    postgresEpoch = fromGregorian 2000 1 1
+
+instance ToField Day where
+  toField x = Just (Oid.date, encodeBigEndian @Int32 4 $ fromIntegral $ toPostgresJulian x, Binary)

opium.cabal

@@ -119,7 +119,8 @@ test-suite opium-test
         SpecHook,
         Database.PostgreSQL.OpiumSpec,
         Database.PostgreSQL.Opium.FromFieldSpec,
-        Database.PostgreSQL.Opium.FromRowSpec
+        Database.PostgreSQL.Opium.FromRowSpec,
+        Database.PostgreSQL.Opium.ToFieldSpec
 
     -- Test dependencies.
     build-depends:

test/Database/PostgreSQL/Opium/ToFieldSpec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.PostgreSQL.Opium.ToFieldSpec (spec) where
+
+import Data.Functor.Identity (Identity (..))
+import Data.Text (Text)
+import Data.Time (fromGregorian)
+import GHC.Generics (Generic)
+import Test.Hspec (SpecWith, describe, it, shouldBe)
+
+import qualified Database.PostgreSQL.Opium as Opium
+
+newtype Result = Result
+  { a :: Bool
+  } deriving (Show, Eq, Generic)
+
+instance Opium.FromRow Result
+
+shouldBeTrue :: Opium.ToParamList p => Opium.Connection -> Text -> p -> IO ()
+shouldBeTrue conn query params = do
+  result <- Opium.fetch query params conn
+  result `shouldBe` Right (Identity (Result True))
+
+spec :: SpecWith Opium.Connection
+spec = do
+  describe "ToField Day" $ do
+    it "Encodes Day" $ \conn -> do
+      shouldBeTrue conn "SELECT $1 = date '1997-09-29' AS a" (Identity $ fromGregorian 1997 9 29)
+      shouldBeTrue conn "SELECT $1 = date '2025-07-28' AS a" (Identity $ fromGregorian 2025 7 28)