opium/test/Database/PostgreSQL/Opium/FromFieldSpec.hs

{-# 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 AnInteger = AnInteger
  { integer :: Integer
  } deriving (Eq, Generic, Show)

instance FromRow AnInteger 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 AChar = AChar
  { char :: Char
  } deriving (Eq, Generic, Show)

instance FromRow AChar 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 pow(2, 48)::BIGINT AS int" [AnInt $ (2 :: Int) ^ (48 :: Int)]

  describe "FromField Integer" $ do
    it "Decodes smallint" $ \conn -> do
      shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]

    it "Decodes integer" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 20)::INTEGER AS integer" [AnInteger $ (2 :: Integer) ^ (20 :: Integer)]

    it "Decodes bigint" $ \conn -> do
      shouldFetch conn "SELECT pow(2, 48)::BIGINT AS integer" [AnInteger $ (2 :: Integer) ^ (48 :: Integer)]

  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 Char" $ do
    it "Decodes text" $ \conn -> do
      shouldFetch conn "SELECT 'X'::TEXT AS char" [AChar 'X']

    it "Decodes character" $ \conn -> do
      shouldFetch conn "SELECT 'XYZ'::CHARACTER(1) AS char" [AChar 'X']
      shouldFetch conn "SELECT ''::CHARACTER(1) AS char" [AChar ' ']

    it "Decodes character varying" $ \conn -> do
      shouldFetch conn "SELECT 'X'::CHARACTER VARYING (20) AS char" [AChar 'X']

  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]