opium/test/Database/PostgreSQL/OpiumSpec.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Database.PostgreSQL.OpiumSpec (spec) where

import Data.ByteString (ByteString)
import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)

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

newtype MaybeTest = MaybeTest
  { a :: Maybe String
  } deriving (Eq, Generic, Show)

instance Opium.FromRow MaybeTest where

data ManyFields = ManyFields
  { a :: Text
  , b :: Int
  , c :: Double
  , d :: String
  , e :: Bool
  } deriving (Eq, Generic, Show)

instance Opium.FromRow ManyFields where

data ScoreByAge = ScoreByAge
  { m :: Double
  , t :: Double
  } deriving (Eq, Generic, Show)

instance Opium.FromRow ScoreByAge where

newtype Only a = Only
  { only :: a
  } deriving (Eq, Generic, Show)

instance Opium.FromField a => Opium.FromRow (Only a) where

isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft _ = False

shouldHaveColumns
  :: Opium.FromRow a
  => Proxy a
  -> 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.toListColumnTable) columnTable
  actualColumns `shouldBe` Right expectedColumns

spec :: SpecWith Connection
spec = 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)

  describe "fetch" $ do
    it "Passes numbered parameters and retrieves a list of rows" $ \conn -> do
      rows <- Opium.fetch conn "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int)
      rows `shouldBe` Right [Only (42 :: Int)]

    it "Uses Identity to pass single parameters" $ \conn -> do
      rows <- Opium.fetch conn "SELECT count(*) AS only FROM person WHERE name = $1" $ Identity ("paul" :: Text)
      rows `shouldBe` Right [Only (1 :: Int)]

  describe "fetch_" $ do
    it "Retrieves a list of rows" $ \conn -> do
      rows <- Opium.fetch_ conn "SELECT * FROM person"
      rows `shouldBe` Right [Person "paul" 25, Person "albus" 103]

    it "Fails for invalid queries" $ \conn -> do
      rows <- Opium.fetch_ @Person conn "MRTLBRNFT"
      rows `shouldSatisfy` isLeft

    it "Fails for unexpected NULLs" $ \conn -> do
      rows <- Opium.fetch_ @Person conn "SELECT NULL AS name, 0 AS age"
      rows `shouldBe` Left (Opium.ErrorUnexpectedNull (Opium.ErrorPosition 0 "name"))

    it "Fails for the wrong column type" $ \conn -> do
      rows <- Opium.fetch_ @Person conn "SELECT 'quby' AS name, 'indeterminate' AS age"
      rows `shouldBe` Left (Opium.ErrorInvalidOid "age" $ LibPQ.Oid 25)

    it "Works for the readme regression example" $ \conn -> do
      rows <- Opium.fetch_ @ScoreByAge conn "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM person"
      rows `shouldSatisfy` \case { (Right [ScoreByAge _ _]) -> True; _ -> False }