31 lines
981 B
Haskell
31 lines
981 B
Haskell
{-# 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)
|