Tests.hs

{-#LANGUAGE QuasiQuotes #-}
{-#LANGUAGE RankNTypes #-}
{-#LANGUAGE LambdaCase #-}
{-#LANGUAGE TemplateHaskell #-}
module Database.YeshQL.PostgreSQL.Tests
( tests
)
where

import Test.Tasty
import Test.Tasty.HUnit
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Database.YeshQL.PostgreSQL
import System.IO
import Data.Char
import Data.List (dropWhile, dropWhileEnd)

data User = User
  { userID :: Int
  , userName :: String
  } deriving (Show, Eq)

instance FromRow User where
  fromRow = User <$> field <*> field

data Person = Person
  { personName :: String
  , personEmail :: String
  } deriving (Show, Eq)

data UserData = UserData
  { user :: User
  , person :: Person
  } deriving (Show, Eq)

instance FromRow UserData where
  fromRow =
    UserData
    <$> (User <$> field <*> field)
    <*> (Person <$> field <*> field)

tests conn =
  map
    ($ conn)
    [ testSimpleSelect
    , testSimpleSelectStr
    , testParametrizedSelect
    , testSingleInsert
    , testRecordReturn
    , testRecordReturnComplex
    , testRecordReturnExcessive
    , testTupleReturnMany
    , testRecordReturnMany
    , testRecordParams
    , testUpdateReturnRowCount
    , testMultiQuery
    , testQueryFromFile
    , testQueryFromFileAutoName
    , testDDL
    ]

testSimpleSelect :: Connection -> TestTree
testSimpleSelect conn = testCase "Simple SELECT" $ do
    results <- [yesh|
        -- name:getUserByName :: (String)
        SELECT username FROM users|] conn
    return ()

testEmptyReturn :: Connection -> TestTree
testEmptyReturn conn = testCase "Simple SELECT (empty return)" $ do
    [yesh|
        -- name:getUserByName :: ()
        SELECT username FROM users WHERE 0|] conn

testSimpleSelectStr :: Connection -> TestTree
testSimpleSelectStr conn = testCase "Simple SELECT (expr by string)" $ do
    results <- $(yesh $ unlines
        [ "-- name:getUserByName :: (String)"
        , "SELECT username FROM users"
        ]) conn
    return ()

testParametrizedSelect :: Connection -> TestTree
testParametrizedSelect conn = testCase "Parametrized SELECT" $ do
    actual <- [yesh|
        -- name:getUserByName :: (Integer, String)
        -- :username :: String
        SELECT id, username FROM users WHERE username = :username LIMIT 1|] conn "billy"
    let expected :: Maybe (Integer, String)
        expected = Just (1, "billy")
    assertEqual "" expected actual

testRecordReturn :: Connection -> TestTree
testRecordReturn conn = testCase "Return record from SELECT" $ do
    actual <- [yesh|
        -- name:getUserByName :: User
        -- :username :: String
        SELECT id, username FROM users WHERE username = :username LIMIT 1|]
        conn
        "billy"
    let expected :: Maybe User
        expected = Just $ User 1 "billy"
    assertEqual "" expected actual

testRecordReturnComplex :: Connection -> TestTree
testRecordReturnComplex conn = testCase "Return record from SELECT" $ do
    actual <- [yesh|
        -- name:getUserByName :: UserData
        -- :username :: String
        SELECT id, username, person_name, email FROM users WHERE username = :username and id = 1|]
        conn
        "billy"
    let expected :: Maybe UserData
        expected = Just $ UserData (User 1 "billy") (Person "Billy" "billy@example.org")
    assertEqual "" expected actual

testRecordReturnExcessive :: Connection -> TestTree
testRecordReturnExcessive conn = testCase "Return record from SELECT (extra values ignored)" $ do
    actual <- [yesh|
        -- name:getUserByName :: User
        -- :username :: String
        SELECT id, username FROM users WHERE username = :username LIMIT 1|]
        conn
        "billy"
    let expected :: Maybe User
        expected = Just $ User 1 "billy"
    assertEqual "" expected actual

testTupleReturnMany :: Connection -> TestTree
testTupleReturnMany conn = testCase "Return a list of single-element tuples" $ do
  actual <- [yesh|
    -- name:getUsers :: [(String)]
    select username from Users|] conn
  let expected = ["billy", "billy"]
  assertEqual "" expected actual

testRecordReturnMany :: Connection -> TestTree
testRecordReturnMany conn = testCase "Return a list of records from SELECT" $ do
  actual <- [yesh|
    -- name:getUsers :: [User]
    select id, username from Users|] conn
  let expected = [User 1 "billy", User 2 "billy"]
  assertEqual "" expected actual

testRecordParams :: Connection -> TestTree
testRecordParams conn = testCase "Pass records as params" $ do
    actual <- [yesh|
        -- name:getUserByName :: User
        -- :user :: User
        SELECT id, username FROM users WHERE username = :user.userName.reverse LIMIT 1|]
        conn
        (User 10 "yllib")
    let expected :: Maybe User
        expected = Just $ User 1 "billy"
    assertEqual "" expected actual

testSingleInsert :: Connection -> TestTree
testSingleInsert conn = testCase "Single INSERT" $ do
    actual <- [yesh|
        -- name:createUser :: (Integer)
        -- :username :: String
        INSERT INTO users (username) VALUES (:username) RETURNING id|] conn "billy"
    let expected :: Maybe Integer
        expected = Just 2
    assertEqual "" expected actual

testUpdateReturnRowCount :: Connection -> TestTree
testUpdateReturnRowCount conn = testCase "UPDATE, get row count" $ do
    actual <- [yesh|
        -- name:renameUser :: rowcount Integer
        -- :oldName :: String
        -- :newName :: String
        UPDATE users SET username = :oldName WHERE username = :newName AND username <> :oldName|]
            conn "tony" "billy"
    let expected :: Integer
        expected = 2
    assertEqual "" expected actual

[yesh|
    -- name:findUser :: (Int)
    -- :username :: String
    SELECT id FROM users WHERE username = :username
    ;;;
    -- name:setUserName :: rowcount Integer
    -- :userID :: Int
    -- :username :: String
    UPDATE users SET username = :username WHERE id = :userID
|]

testMultiQuery :: Connection -> TestTree
testMultiQuery conn = testCase "Define multiple queries in one QQ inside a where" $ do
    userID <- maybe (fail "User Not Found") return =<< findUser conn "tony"
    rowCount <- setUserName conn userID "billy"
    assertEqual "" rowCount 1

testQueryFromFile :: Connection -> TestTree
testQueryFromFile conn = testCase "Query loaded from fixture file" $ do
    [(userID, username)] <- [yesh1File|tests/fixtures/getUserNamed.sql|] conn 1
    assertEqual "" userID 1
    assertEqual "" username "billy"

[yesh1File|tests/fixtures/getUser.sql|]

testQueryFromFileAutoName :: Connection -> TestTree
testQueryFromFileAutoName conn = testCase "Query loaded from fixture file, deriving query name from filename" $ do
    [(userID, username)] <- getUser conn 1
    assertEqual "" userID 1
    assertEqual "" username "billy"

[yeshFile|tests/fixtures/multiQueries.sql|]

testManyQueriesFromFileAutoName :: Connection -> TestTree
testManyQueriesFromFileAutoName conn = testCase "Many queries from fixture file, auto-naming some" $ do
    count0 <- multiQueries_0 conn
    count1 <- multiQueriesNamed conn
    count2 <- multiQueries_2 conn
    assertEqual "" count0 1
    assertEqual "" count1 2
    assertEqual "" count2 3

testDDL :: Connection -> TestTree
testDDL conn = testCase "typical DDL statement sequence" $ do
    [yesh1|
        -- @ddl
        CREATE TABLE users_tmp
            ( id INTEGER
            , username TEXT
            );
        CREATE TABLE pages
            ( id INTEGER
            , owner_id INTEGER
            , title TEXT
            , body TEXT
            , FOREIGN KEY (owner_id) REFERENCES users (id)
            );
    |] conn