generic-persistence-0.2.0.0: test/ReferenceSpec.hs

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

import          Test.Hspec
import          Data.Data
import          Database.HDBC
import          Database.HDBC.Sqlite3
import          Database.GP.GenericPersistence
import          RIO    

-- `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
  }
  deriving (Data, Entity, Show, Eq)  

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

  fromRow row = do
    maybeAuthor <- retrieveById (row !! 2) :: GP (Maybe Author)
    let author = fromMaybe (error "Author not found") maybeAuthor
    pure $ Article (col 0) (col 1) author (col 3)
    where
      col i = fromSql (row !! i)
      
  toRow a = do 
    persist (author a)
    return [toSql (articleID a), toSql (title a), toSql $ authorID (author a), toSql (year a)]

article :: Article
article = Article 
  { articleID = 1, 
    title = "Persistence without Boilerplate", 
    author = arthur, 
    year = 2018}
    
arthur :: Author
arthur = Author 
  {authorID = 2, 
  name = "Arthur Miller", 
  address = "Denver"}    

spec :: Spec
spec = do
  describe "Handling of 1:1 References" $ do
    it "works like a charm" $ 
      withDatabase $ do
        insert article

        author' <- retrieveById "2" :: GP (Maybe Author)
        liftIO $ author' `shouldBe` Just arthur
        
        article' <- retrieveById "1" :: GP (Maybe Article)
        liftIO $ article' `shouldBe` Just article