38 lines
1.1 KiB
Haskell
38 lines
1.1 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Database.PostgreSQL.OpiumSpec (spec) where
|
|
|
|
import Data.Text (Text)
|
|
import Database.PostgreSQL.LibPQ (Connection)
|
|
import GHC.Generics (Generic)
|
|
import Test.Hspec (SpecWith, describe, it, shouldBe)
|
|
|
|
import qualified Database.PostgreSQL.LibPQ as LibPQ
|
|
import qualified Database.PostgreSQL.Opium as Opium
|
|
|
|
data Person = Person
|
|
{ name :: Text
|
|
, age :: Int
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance Opium.FromRow Person where
|
|
|
|
spec :: SpecWith Connection
|
|
spec = do
|
|
describe "fromRow" $ do
|
|
it "decodes rows in a Result" $ \conn -> do
|
|
Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Text
|
|
|
|
row0 <- Opium.fromRow @Person (LibPQ.Row 0) result
|
|
row0 `shouldBe` Just (Person "paul" 25)
|
|
|
|
row1 <- Opium.fromRow @Person (LibPQ.Row 1) result
|
|
row1 `shouldBe` Just (Person "albus" 103)
|
|
|
|
describe "fetch_" $ do
|
|
it "retrieves a list of rows" $ \conn -> do
|
|
rows <- Opium.fetch_ conn "SELECT * FROM person"
|
|
rows `shouldBe` Just [Person "paul" 25, Person "albus" 103]
|