generic-persistence-0.2.0.0: test/OneToManySpec.hs

{-# LANGUAGE DeriveAnyClass     #-}  -- allows automatic derivation from Entity type class
module OneToManySpec
  ( test
  , spec
  ) where

import          Test.Hspec
import          Data.Data
import          Database.HDBC
import          Database.HDBC.Sqlite3
import          Database.GP.GenericPersistence
import          RIO    
import          Data.Maybe (fromJust)

-- `test` is here so that this module can be run from GHCi on its own.  It is
-- not needed for automatic spec discovery. (start up stack repl --test to bring up ghci and have access to all the test functions)
test :: IO ()
test = hspec spec

withDatabase :: RIO Ctx a -> IO a
withDatabase action = do
  conn <- connectSqlite3 ":memory:"
  runGP conn $ do
    _ <- setupTableFor :: GP Article
    _ <- setupTableFor :: GP Author
    action

data Article = Article
  { articleID :: Int,
    title     :: String,
    author    :: Author,
    year      :: Int
  }
  deriving (Data, Show, Eq)

data Author = Author
  { authorID :: Int,
    name     :: String,
    address  :: String,
    articles :: [Article]
  }
  deriving (Data, Show, Eq)  

instance Entity Article where
  fieldsToColumns :: Article -> [(String, String)]
  fieldsToColumns _ = [("articleID", "articleID"),
                       ("title", "title"), 
                       ("authorID", "authorID"),
                       ("year", "year")
                      ]

  fromRow :: [SqlValue] -> GP Article
  fromRow row = local (extendCtxCache rawArticle) $ do
    maybeAuthor <- getElseRetrieve (entityId rawAuthor)
    let author = fromJust maybeAuthor
    pure $ Article (col 0) (col 1) author (col 3)
    where
      col i = fromSql (row !! i)
      rawAuthor = (evidence :: Author) {authorID = col 2}
      rawArticle = Article (col 0) (col 1) rawAuthor (col 3)
    
  toRow a = do 
    persist (author a)
    return [toSql (articleID a), toSql (title a), toSql $ authorID (author a), toSql (year a)]


instance Entity Author where
  fieldsToColumns :: Author -> [(String, String)]
  fieldsToColumns _ = [("authorID", "authorID"),
                       ("name", "name"), 
                       ("address", "address")
                      ]

  fromRow :: [SqlValue] -> GP Author
  fromRow row = local (extendCtxCache rawAuthor) $ do
    articlesByAuth <- retrieveAllWhere (idField rawAuthor) (idValue rawAuthor) :: GP [Article]
    pure $ rawAuthor {articles= articlesByAuth}
    where
      col i = fromSql (row !! i)
      rawAuthor = Author (col 0) (col 1) (col 2) []

  toRow :: Author -> GP [SqlValue]
  toRow a = do 
    return [toSql (authorID a), toSql (name a), toSql (address a)]

article1 :: Article
article1 = Article 
  { articleID = 1, 
    title = "Persistence without Boilerplate", 
    author = Author 
      {authorID = 1, 
      name = "Max Millian", 
      address = "Boston",
      articles = []}, 
    year = 2018}

article2 :: Article
article2 = Article 
  { articleID = 2, 
    title = "Boilerplate for Dummies", 
    author = arthur, 
    year = 2020}

article3 :: Article
article3 = Article 
  { articleID = 3, 
    title = "The return of the boilerplate", 
    author = arthur, 
    year = 2022}

arthur :: Author
arthur = Author 
  {authorID = 2, 
  name = "Arthur Miller", 
  address = "Denver", 
  articles = [article2, article3]}    

spec :: Spec
spec = do
  describe "Handling of 1:N References" $ do
    it "works like a charm" $ 
      withDatabase $ do
        insert article1
        insert article2
        insert article3

        authors <- retrieveAll :: GP [Author]
        liftIO $ length authors `shouldBe` 2
        --liftIO $ print authors
        articles <- retrieveAll :: GP [Article]
        liftIO $ length articles `shouldBe` 3
        
        article' <- retrieveById "3" :: GP (Maybe Article)
        let art = fromJust article'
        liftIO $ (name (author art)) `shouldBe` "Arthur Miller"