147 lines
5.3 KiB
Haskell
147 lines
5.3 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, shouldSatisfy)
|
|
|
|
import qualified Database.PostgreSQL.Opium as Opium
|
|
|
|
newtype AnInt = AnInt
|
|
{ int :: Int
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow AnInt where
|
|
|
|
newtype AText = AText
|
|
{ text :: Text
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow AText where
|
|
|
|
newtype AString = AString
|
|
{ string :: String
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow AString where
|
|
|
|
newtype AFloat = AFloat
|
|
{ float :: Float
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow AFloat
|
|
|
|
newtype ADouble = ADouble
|
|
{ double :: Double
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow ADouble where
|
|
|
|
newtype ABool = ABool
|
|
{ bool :: Bool
|
|
} deriving (Eq, Generic, Show)
|
|
|
|
instance FromRow ABool where
|
|
|
|
shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> ByteString -> [a] -> IO ()
|
|
shouldFetch conn query expectedRows = do
|
|
actualRows <- Opium.fetch_ conn query
|
|
actualRows `shouldBe` Right expectedRows
|
|
|
|
(/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
|
|
p /\ q = \x -> p x && q x
|
|
|
|
spec :: SpecWith Connection
|
|
spec = do
|
|
describe "FromField Int" $ do
|
|
it "Decodes smallint" $ \conn -> do
|
|
shouldFetch conn "SELECT 42::SMALLINT AS int" [AnInt 42]
|
|
|
|
it "Decodes integer" $ \conn -> do
|
|
shouldFetch conn "SELECT 42::INTEGER AS int" [AnInt 42]
|
|
|
|
it "Decodes bigint" $ \conn -> do
|
|
shouldFetch conn "SELECT 42::BIGINT AS int" [AnInt 42]
|
|
|
|
describe "FromField Text" $ do
|
|
it "Decodes text" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"]
|
|
|
|
it "Decodes character" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS text" [AText "Hello, Wor"]
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS text" [AText "Hello, World! "]
|
|
|
|
it "Decodes character varying" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS text" [AText "Hello, World!"]
|
|
|
|
describe "FromField String" $ do
|
|
it "Decodes text" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::TEXT AS string" [AString "Hello, World!"]
|
|
|
|
it "Decodes character" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS string" [AString "Hello, Wor"]
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS string" [AString "Hello, World! "]
|
|
|
|
it "Decodes character varying" $ \conn -> do
|
|
shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [AString "Hello, World!"]
|
|
|
|
describe "FromField Float" $ do
|
|
it "Decodes real" $ \conn -> do
|
|
shouldFetch conn "SELECT 4.2::real AS float" [AFloat 4.2]
|
|
|
|
it "Decodes NaN::real" $ \conn -> do
|
|
Right [AFloat value] <- Opium.fetch_ conn "SELECT 'NaN'::real AS float"
|
|
value `shouldSatisfy` isNaN
|
|
|
|
it "Decodes Infinity::real" $ \conn -> do
|
|
Right [AFloat value] <- Opium.fetch_ conn "SELECT 'Infinity'::real AS float"
|
|
value `shouldSatisfy` (isInfinite /\ (> 0))
|
|
|
|
it "Decodes -Infinity::real" $ \conn -> do
|
|
Right [AFloat value] <- Opium.fetch_ conn "SELECT '-Infinity'::real AS float"
|
|
value `shouldSatisfy` (isInfinite /\ (< 0))
|
|
|
|
describe "FromField Double" $ do
|
|
it "Decodes double precision" $ \conn -> do
|
|
shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2]
|
|
|
|
it "Decodes real" $ \conn -> do
|
|
shouldFetch conn "SELECT 4.2::real AS double" [ADouble 4.2]
|
|
|
|
it "Decodes NaN::double precision" $ \conn -> do
|
|
Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double"
|
|
value `shouldSatisfy` isNaN
|
|
|
|
it "Decodes Infinity::double precision" $ \conn -> do
|
|
Right [ADouble value] <- Opium.fetch_ conn "SELECT 'Infinity'::double precision AS double"
|
|
value `shouldSatisfy` (isInfinite /\ (> 0))
|
|
|
|
it "Decodes -Infinity::double precision" $ \conn -> do
|
|
Right [ADouble value] <- Opium.fetch_ conn "SELECT '-Infinity'::double precision AS double"
|
|
value `shouldSatisfy` (isInfinite /\ (< 0))
|
|
|
|
it "Decodes {inf,-inf}::double precision" $ \conn -> do
|
|
Right [ADouble value0] <- Opium.fetch_ conn "SELECT 'inf'::double precision AS double"
|
|
value0 `shouldSatisfy` (isInfinite /\ (> 0))
|
|
|
|
Right [ADouble value1] <- Opium.fetch_ conn "SELECT '-inf'::double precision AS double"
|
|
value1 `shouldSatisfy` (isInfinite /\ (< 0))
|
|
|
|
describe "FromField Bool" $ do
|
|
it "Decodes boolean" $ \conn -> do
|
|
shouldFetch conn "SELECT true AS bool" [ABool True]
|
|
shouldFetch conn "SELECT 't'::boolean AS bool" [ABool True]
|
|
shouldFetch conn "SELECT 'yes'::boolean AS bool" [ABool True]
|
|
shouldFetch conn "SELECT 'on'::boolean AS bool" [ABool True]
|
|
shouldFetch conn "SELECT 1::boolean AS bool" [ABool True]
|
|
shouldFetch conn "SELECT false AS bool" [ABool False]
|
|
shouldFetch conn "SELECT 'f'::boolean AS bool" [ABool False]
|
|
shouldFetch conn "SELECT 'no'::boolean AS bool" [ABool False]
|
|
shouldFetch conn "SELECT 'off'::boolean AS bool" [ABool False]
|
|
shouldFetch conn "SELECT 0::boolean AS bool" [ABool False]
|