93 lines
3.7 KiB
Haskell
93 lines
3.7 KiB
Haskell
{-# 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)
|