pg-entity-0.0.2.0: test/EntitySpec.hs

{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}

module EntitySpec where

import Control.Monad (void)
import Control.Monad.IO.Class
import Data.Text (Text)
import qualified Data.UUID as UUID
import qualified Data.Vector as V
import Database.PostgreSQL.Entity
  ( delete
  , deleteByField
  , joinSelectOneByField
  , selectById
  , selectManyByField
  , selectOneByField
  , selectOneWhereIn
  , selectOrderBy
  , selectWhereNotNull
  , selectWhereNull
  , update
  , updateFieldsBy
  , _joinSelectWithFields
  , _where
  )
import Database.PostgreSQL.Entity.DBT (QueryNature (..), query)
import Database.PostgreSQL.Entity.Internal.BlogPost
  ( Author (..)
  , AuthorId (..)
  , BlogPost (..)
  , bulkInsertAuthors
  , bulkInsertBlogPosts
  , insertAuthor
  , insertBlogPost
  , upsertBlogPost
  )
import Database.PostgreSQL.Simple (Only (Only))
import Database.PostgreSQL.Transact (DBT)

import Data.Maybe (fromJust)
import qualified Data.Set as S
import qualified Data.Set as Set
import Data.Vector (Vector)
import Database.PostgreSQL.Entity.Types
import Optics.Core
import Test.Tasty
import Utils
import qualified Utils as U

spec :: TestM TestTree
spec =
  testThese
    "Entity Tests"
    [ testThis "Select blog post by title" selectBlogPostByTitle
    , testThis "Select blog posts by null and non-null condition" selectByNullAndNonNull
    , testThis "Select multiple blog posts by author id" selectManyByAuthorId
    , testThis "Delete blog posts" deleteBlogPosts
    , testThis "Get all the article titles by author name" getAllTitlesByAuthorName
    , testThis "Change the name of an author" changeAuthorName
    , testThis "Select a row when the value of title is in an array of possible values" selectWhereIn
    , testThis "SELECT ORDER BY yields the appropriate results" testSelectOrderBy
    , testThis "select blog posts by author's name" selectBlogpostsByAuthorName
    , testThis "Insert many blog posts" insertManyBlogPosts
    , testThis "Upsert a blog post" testUpsertBlogPost
    ]

selectBlogPostByTitle :: TestM ()
selectBlogPostByTitle = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate
  blogPost <- liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  result <- liftDB $ selectOneByField @BlogPost [field| title |] (Only (blogPost ^. #title))
  U.assertEqual result (Just blogPost)

selectByNullAndNonNull :: TestM ()
selectByNullAndNonNull = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate

  liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}

  result <- liftDB $ selectWhereNotNull @BlogPost [[field| author_id |], [field| title |]]
  U.assertEqual True (not . null $ result)
  result1 <- liftDB $ selectWhereNull @BlogPost [[field| author_id |], [field| content |]]
  U.assertEqual 0 (V.length result1)

selectManyByAuthorId :: TestM ()
selectManyByAuthorId = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate

  blogPost4 <- liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  blogPost2 <- liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  blogPost3 <- liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  result <- liftDB $ selectManyByField @BlogPost [field| author_id |] $ Only (#authorId blogPost4)
  U.assertEqual (Set.fromList [blogPost2, blogPost3, blogPost4]) (Set.fromList $ V.toList result)

deleteBlogPosts :: TestM ()
deleteBlogPosts = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate

  blogPost1 <- liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateTitle = pure "Echoes from the other world", generateAuthorId = pure (author ^. #authorId)}
  blogPost2 <- liftDB $ instantiateRandomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  liftDB $ delete @BlogPost (Only (blogPostId blogPost2))
  result <- liftDB $ selectManyByField @BlogPost [field| blogpost_id |] $ Only (#blogPostId blogPost2)
  U.assertEqual 0 (V.length result)

  liftDB $ deleteByField @BlogPost [[field| title |]] (Only @Text "Echoes from the other world")
  result1 <- liftDB $ selectManyByField @BlogPost [field| title |] $ Only (#title blogPost1)
  U.assertEqual 0 (V.length result1)

getAllTitlesByAuthorName :: TestM ()
getAllTitlesByAuthorName = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate{generateName = pure "Hansi Kürsch"}

  liftDB $
    instantiateRandomBlogPost
      randomBlogPostTemplate
        { generateTitle = pure "The Script for my requiem"
        , generateAuthorId = pure (author ^. #authorId)
        }
  liftDB $
    instantiateRandomBlogPost
      randomBlogPostTemplate
        { generateAuthorId = pure (author ^. #authorId)
        , generateTitle = pure "Mordred's Song"
        }

  let q =
        _joinSelectWithFields @BlogPost @Author [[field| title |]] [[field| name |]]
          <> _where [[field| name |]]
  result <- liftDB (query Select q (Only ("Hansi Kürsch" :: Text)) :: (MonadIO m) => DBT m (Vector (Text, Text)))
  U.assertEqual [("The Script for my requiem", "Hansi Kürsch"), ("Mordred's Song", "Hansi Kürsch")] result

changeAuthorName :: TestM ()
changeAuthorName = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate

  blogPost <- randomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  liftDB $ insertBlogPost blogPost

  let newAuthor = author{name = "Hannah Kürsch"}
  liftDB $ update @Author newAuthor
  result1 <- liftDB $ selectById (Only (#authorId author))
  U.assertEqual (Just newAuthor) result1

  author2 <- liftDB $ instantiateRandomAuthor randomAuthorTemplate
  let newAuthorId = UUID.toText $ getAuthorId $ #authorId author2 :: Text
  let newTitle = "Something Entirely New with a lone quote '" :: Text
  modifiedRows <- liftDB $ updateFieldsBy @BlogPost [[field| author_id |], [field| title |]] ([field| title |], #title blogPost) (newAuthorId, newTitle)
  result2 <- liftDB $ selectManyByField @BlogPost [field| author_id |] (Only (#authorId author2))
  U.assertEqual (fromIntegral modifiedRows) (V.length result2)

  let oldName = "Johnson McElroy" :: Text
  liftDB $ instantiateRandomAuthor randomAuthorTemplate{generateName = pure oldName}
  let newName = "Tiberus McElroy" :: Text
  result3 <- liftDB $ updateFieldsBy @Author [[field| name |]] ([field| name |], oldName) (Only newName)
  U.assertEqual 1 result3

selectWhereIn :: TestM ()
selectWhereIn = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate
  blogPost <-
    liftDB $
      instantiateRandomBlogPost
        randomBlogPostTemplate
          { generateAuthorId = pure (author ^. #authorId)
          , generateTitle = pure "Testing unescaped single quotes ' :)"
          }
  result <- liftDB $ selectOneWhereIn @BlogPost [field| title |] ["Testing unescaped single quotes ' :)", "Doesn't exist lol"]
  U.assertEqual (Just blogPost) result

testSelectOrderBy :: TestM ()
testSelectOrderBy = do
  author1 <-
    liftDB $
      instantiateRandomAuthor
        randomAuthorTemplate
          { generateName = pure "Alphabetically first"
          , generateCreatedAt = pure (read "2013-03-16 21:38:36Z")
          }

  author2 <-
    liftDB $
      instantiateRandomAuthor
        randomAuthorTemplate
          { generateName = pure "Blphabetically first"
          , generateCreatedAt = pure (read "2012-03-16 21:38:36Z")
          }

  let authors = V.fromList [author1, author2]

  result1 <- V.filter (\a -> a `V.elem` authors) <$> liftDB (selectOrderBy @Author (V.fromList [([field| name |], ASC)]))
  U.assertEqual authors result1

  let reverseAuthors = V.fromList [author2, author1]
  result2 <- V.filter (\a -> a `V.elem` authors) <$> liftDB (selectOrderBy @Author (V.fromList [([field| name |], DESC)]))
  U.assertEqual reverseAuthors result2

  author3 <-
    liftDB $
      instantiateRandomAuthor
        randomAuthorTemplate
          { generateName = pure "Blphabetically first"
          , generateCreatedAt = pure (read "2011-03-16 21:38:36Z")
          }
  let threeAuthors = V.fromList [author1, author3, author2]
  result3 <-
    V.filter (\a -> a `V.elem` threeAuthors)
      <$> liftDB (selectOrderBy @Author (V.fromList [([field| name |], ASC), ([field| created_at |], ASC)]))
  U.assertEqual threeAuthors result3

selectBlogpostsByAuthorName :: TestM ()
selectBlogpostsByAuthorName = do
  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate{generateName = pure "Alfonso Bertholt"}
  blogPost1 <-
    liftDB $
      instantiateRandomBlogPost
        randomBlogPostTemplate
          { generateAuthorId = pure (author ^. #authorId)
          }
  blogPost2 <-
    liftDB $
      instantiateRandomBlogPost
        randomBlogPostTemplate
          { generateAuthorId = pure (author ^. #authorId)
          }
  result <- liftDB $ joinSelectOneByField @BlogPost @Author [field| author_id |] [field| name |] (author ^. #name)
  U.assertEqual (S.fromList [blogPost1, blogPost2]) (S.fromList $ V.toList result)

insertManyBlogPosts :: TestM ()
insertManyBlogPosts = do
  author1 <- randomAuthor randomAuthorTemplate{generateName = pure "Vivienne Brooks"}
  author2 <- randomAuthor randomAuthorTemplate{generateName = pure "Léana Garibaldi"}
  void $ liftDB $ bulkInsertAuthors [author1, author2]

  author <- liftDB $ instantiateRandomAuthor randomAuthorTemplate{generateName = pure "Léana Garibaldi"}
  blogPost1 <- randomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  blogPost2 <- randomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author ^. #authorId)}
  void $ liftDB $ bulkInsertBlogPosts [blogPost1, blogPost2]
  result <- liftDB $ joinSelectOneByField @BlogPost @Author [field| author_id |] [field| name |] (author ^. #name)
  U.assertEqual (S.fromList [blogPost1, blogPost2]) (S.fromList $ V.toList result)

testUpsertBlogPost :: TestM ()
testUpsertBlogPost = do
  author1 <- randomAuthor randomAuthorTemplate{generateName = pure "Vivienne Brooks"}
  void $ liftDB $ insertAuthor author1
  blogPost1 <- randomBlogPost randomBlogPostTemplate{generateAuthorId = pure (author1 ^. #authorId)}
  blogPost2 <- randomBlogPost randomBlogPostTemplate{generateBlogPostId = pure (blogPost1 ^. #blogPostId), generateAuthorId = pure (author1 ^. #authorId), generateTitle = pure "New title"}

  void $ liftDB $ insertBlogPost blogPost1
  void $ liftDB $ upsertBlogPost blogPost2 [[field| title |]]

  r <- liftDB $ selectById @BlogPost (Only (blogPost1 ^. #blogPostId))
  let result = fromJust r
  U.assertEqual (result ^. #title) (blogPost2 ^. #title)