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.Either (isLeft)
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
import qualified Database.PostgreSQL.Opium.FromRow as Opium.FromRow

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

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.FromRow.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 "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
      rows `shouldBe` Right [Only (42 :: Int)]

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

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

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

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

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

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

    it "Accepts exactly one row when Identity is the row container type" $ \conn -> do
      row <- Opium.fetch_ "SELECT 42 AS only" conn
      row `shouldBe` Right (Identity (Only (42 :: Int)))

    it "Does not accept zero rows when Identity is the row container type" $ \conn -> do
      row <- Opium.fetch_ @(Only Int) @Identity "SELECT 42 AS only WHERE false" conn
      row `shouldSatisfy` isLeft

    it "Does not accept two rows when Identity is the row container type" $ \conn -> do
      row <- Opium.fetch_ @(Only Int) @Identity "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
      row `shouldSatisfy` isLeft

    it "Accepts zero rows when Maybe is the row container type" $ \conn -> do
      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only WHERE false" conn
      row `shouldBe` Right Nothing

    it "Accepts one row when Maybe is the row container type" $ \conn -> do
      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 42 AS only" conn
      row `shouldBe` Right (Just (Only 42))

    it "Does not accept two rows when Maybe is the row container type" $ \conn -> do
      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
      row `shouldSatisfy` isLeft