71 lines
2.5 KiB
Haskell
71 lines
2.5 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Database.PostgreSQL.Opium.FromFieldSpec (spec) where
|
|
|
|
import Data.ByteString (ByteString)
|
|
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)
|
|
|
|
import qualified Database.PostgreSQL.Opium as Opium
|
|
|
|
newtype SingleInt = SingleInt
|
|
{ int :: Int
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow SingleInt where
|
|
|
|
newtype SingleText = SingleText
|
|
{ text :: Text
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow SingleText where
|
|
|
|
newtype SingleString = SingleString
|
|
{ string :: String
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow SingleString where
|
|
|
|
shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> ByteString -> [a] -> IO ()
|
|
shouldFetch conn query expectedRows = do
|
|
Just actualRows <- Opium.fetch_ conn query
|
|
actualRows `shouldBe` expectedRows
|
|
|
|
spec :: SpecWith Connection
|
|
spec = do
|
|
describe "FromField Int" $ do
|
|
it "Decodes smallint" $ \conn -> do
|
|
shouldFetch conn "SELECT 42::SMALLINT AS int" [SingleInt 42]
|
|
|
|
it "Decodes integer" $ \conn -> do
|
|
shouldFetch conn "SELECT 42::INTEGER AS int" [SingleInt 42]
|
|
|
|
it "Decodes bigint" $ \conn -> do
|
|
shouldFetch conn "SELECT 42::BIGINT AS int" [SingleInt 42]
|
|
|
|
describe "FromField Text" $ do
|
|
it "Decodes text" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [SingleText "Hello, World!"]
|
|
|
|
it "Decodes character" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS text" [SingleText "Hello, Wor"]
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS text" [SingleText "Hello, World! "]
|
|
|
|
it "Decodes character varying" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS text" [SingleText "Hello, World!"]
|
|
|
|
describe "FromField String" $ do
|
|
it "Decodes text" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::TEXT AS string" [SingleString "Hello, World!"]
|
|
|
|
it "Decodes character" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS string" [SingleString "Hello, Wor"]
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS string" [SingleString "Hello, World! "]
|
|
|
|
it "Decodes character varying" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [SingleString "Hello, World!"]
|