Add Connection type

This commit is contained in:
2025-07-15 22:33:19 +02:00
parent 3879c2603f
commit d17865265a
8 changed files with 180 additions and 117 deletions
@@ -14,7 +14,6 @@ import Data.Time
, timeOfDayToTime
)
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
import Database.PostgreSQL.Opium (FromRow)
import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
@@ -113,7 +112,7 @@ newtype ARawField = ARawField
instance FromRow ARawField where
shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> Text -> [a] -> IO ()
shouldFetch :: (Eq a, FromRow a, Show a) => Opium.Connection -> Text -> [a] -> IO ()
shouldFetch conn query expectedRows = do
actualRows <- Opium.fetch_ query conn
actualRows `shouldBe` Right expectedRows
@@ -121,7 +120,7 @@ shouldFetch conn query expectedRows = do
(/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
p /\ q = \x -> p x && q x
spec :: SpecWith Connection
spec :: SpecWith Opium.Connection
spec = do
describe "FromField Int" $ do
it "Decodes smallint" $ \conn -> do
@@ -0,0 +1,92 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.Opium.FromRowSpec (spec) where
import Data.ByteString (ByteString)
import Data.Proxy (Proxy (..))
import Test.Hspec (SpecWith, aroundWith, describe, it, shouldBe)
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Opium.Connection (unsafeWithRawConnection)
import Database.PostgreSQL.OpiumSpec (ManyFields (..), MaybeTest (..), Person (..), Only (..))
import qualified Database.PostgreSQL.Opium as Opium
import qualified Database.PostgreSQL.Opium.FromRow as Opium.FromRow
shouldHaveColumns
:: Opium.FromRow a
=> Proxy a
-> LibPQ.Connection
-> ByteString
-> [LibPQ.Column]
-> IO ()
shouldHaveColumns proxy conn query expectedColumns = do
Just result <- LibPQ.execParams conn query [] LibPQ.Binary
columnTable <- Opium.getColumnTable proxy result
let actualColumns = fmap (map fst . Opium.FromRow.toListColumnTable) columnTable
actualColumns `shouldBe` Right expectedColumns
-- These test the mapping from Result to ColumnTable/FromRow instances.
-- They use the raw LibPQ connection for retrieving the Results.
spec :: SpecWith Opium.Connection
spec = aroundWith unsafeWithRawConnection $ do
describe "getColumnTable" $ do
it "Gets the column table for a result" $ \conn -> do
shouldHaveColumns @Person Proxy conn
"SELECT name, age FROM person"
[0, 1]
it "Gets the numbers right for funky configurations" $ \conn -> do
shouldHaveColumns @Person Proxy conn
"SELECT age, name FROM person"
[1, 0]
shouldHaveColumns @Person Proxy conn
"SELECT 0 AS a, 1 AS b, 2 AS c, age, 4 AS d, name FROM person"
[5, 3]
it "Fails for missing columns" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
columnTable <- Opium.getColumnTable @Person Proxy result
columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
describe "fromRow" $ do
it "Decodes rows in a Result" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @Person Proxy result
row0 <- Opium.fromRow @Person result columnTable 0
row0 `shouldBe` Right (Person "paul" 25)
row1 <- Opium.fromRow @Person result columnTable 1
row1 `shouldBe` Right (Person "albus" 103)
it "Decodes NULL into Nothing for Maybes" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (MaybeTest Nothing)
it "Decodes values into Just for Maybes" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (MaybeTest $ Just "abc")
it "Works for many fields" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (ManyFields "abc" 42 1.0 "test" True)
it "Decodes multiple records into a tuple" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'albus' AS name, 123 AS age, 42 AS only" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @(Person, Only Int) Proxy result
row <- Opium.fromRow @(Person, Only Int) result columnTable 0
row `shouldBe` Right (Person "albus" 123, Only 42)
+7 -78
View File
@@ -4,20 +4,16 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.OpiumSpec (spec) where
module Database.PostgreSQL.OpiumSpec (ManyFields (..), MaybeTest (..), Person (..), Only (..), spec) where
import Data.ByteString (ByteString)
import Data.Either (isLeft)
import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Database.PostgreSQL.Opium as Opium
import qualified Database.PostgreSQL.Opium.FromRow as Opium.FromRow
data Person = Person
{ name :: Text
@@ -55,80 +51,8 @@ newtype Only a = Only
instance Opium.FromField a => Opium.FromRow (Only a) where
shouldHaveColumns
:: Opium.FromRow a
=> Proxy a
-> Connection
-> ByteString
-> [LibPQ.Column]
-> IO ()
shouldHaveColumns proxy conn query expectedColumns = do
Just result <- LibPQ.execParams conn query [] LibPQ.Binary
columnTable <- Opium.getColumnTable proxy result
let actualColumns = fmap (map fst . Opium.FromRow.toListColumnTable) columnTable
actualColumns `shouldBe` Right expectedColumns
spec :: SpecWith Connection
spec :: SpecWith Opium.Connection
spec = do
describe "getColumnTable" $ do
it "Gets the column table for a result" $ \conn -> do
shouldHaveColumns @Person Proxy conn
"SELECT name, age FROM person"
[0, 1]
it "Gets the numbers right for funky configurations" $ \conn -> do
shouldHaveColumns @Person Proxy conn
"SELECT age, name FROM person"
[1, 0]
shouldHaveColumns @Person Proxy conn
"SELECT 0 AS a, 1 AS b, 2 AS c, age, 4 AS d, name FROM person"
[5, 3]
it "Fails for missing columns" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
columnTable <- Opium.getColumnTable @Person Proxy result
columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
describe "fromRow" $ do
it "Decodes rows in a Result" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @Person Proxy result
row0 <- Opium.fromRow @Person result columnTable 0
row0 `shouldBe` Right (Person "paul" 25)
row1 <- Opium.fromRow @Person result columnTable 1
row1 `shouldBe` Right (Person "albus" 103)
it "Decodes NULL into Nothing for Maybes" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (MaybeTest Nothing)
it "Decodes values into Just for Maybes" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (MaybeTest $ Just "abc")
it "Works for many fields" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (ManyFields "abc" 42 1.0 "test" True)
it "Decodes multiple records into a tuple" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'albus' AS name, 123 AS age, 42 AS only" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @(Person, Only Int) Proxy result
row <- Opium.fromRow @(Person, Only Int) result columnTable 0
row `shouldBe` Right (Person "albus" 123, Only 42)
describe "fetch" $ do
it "Passes numbered parameters and retrieves a list of rows" $ \conn -> do
rows <- Opium.fetch "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
@@ -182,3 +106,8 @@ spec = do
it "Does not accept two rows when Maybe is the row container type" $ \conn -> do
row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
row `shouldSatisfy` isLeft
describe "close" $ do
it "Does not crash when called twice on the same connection" $ \conn -> do
Opium.close conn
Opium.close conn