如何使用QuickCheck测试数据库相关的功能？

Question

I need to test a lot of functions that access the database (via Persistent). While I can do this using monadicIO and withSqlitePool it will result in inefficient tests. Each test, not property, but test, will create and destroy the DB pool. How do I prevent this?

Important: Forget about efficiency or elegance. I haven't been able to make the QuickCheck and Persistent types to even compose.

instance (Monad a) => MonadThrow (PropertyM a)

instance (MonadThrow a) => MonadCatch (PropertyM a)

type NwApp = SqlPersistT IO

prop_childCreation :: PropertyM NwApp Bool
prop_childCreation = do
  uid <- pick $ UserKey <$> arbitrary
  lid <- pick $ LogKey <$> arbitrary
  gid <- pick $ Aria2Gid <$> arbitrary
  let createDownload_  = createDownload gid lid uid []
  (Entity pid _) <- run $ createDownload_ Nothing
  dstatus <- pick arbitrary
  parent <- run $ updateGet pid [DownloadStatus =. dstatus]

  let test = do 
        (Entity cid child) <- run $ createDownload_ (Just pid)
        case (parent ^. status, child ^. status) of
          (DownloadComplete ChildrenComplete, DownloadComplete ChildrenNone) -> return True
          (DownloadComplete ChildrenIncomplete, DownloadIncomplete) -> return True
          _ -> return False

  test `catches` [
    Handler (\ (e :: SanityException) -> return True),
    Handler (\ (e :: SomeException) -> return False)
    ]

-- How do I write this function?
runTests = monadicIO $ runSqlite ":memory:" $ do 
 -- whatever I do, this function fails to typecheck

Answer 1

To avoid creating and destroying the DB pool and only set up the DB once, you need to use withSqliteConn in your main function on the outside and then transform each property to use that connection, like in this code:

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
    name String
    age Int Maybe
    deriving Show Eq
|]

type SqlT m = SqlPersistT (NoLoggingT (ResourceT m))

prop_insert_person :: PropertyM (SqlT IO) ()
prop_insert_person = do
  personName <- pick arbitrary
  personAge  <- pick arbitrary
  let person = Person personName personAge

  -- This assertion will fail right now on the second iteration
  -- since I have not implemented the cleanup code
  numEntries <- run $ count ([] :: [Filter Person])
  assert (numEntries == 0)

  personId <- run $ insert person
  result <- run $ get personId
  assert (result == Just person)

main :: IO ()
main = runNoLoggingT $ withSqliteConn ":memory:" $ \connection -> lift $ do
  let 
    -- Run a SqlT action using our connection
    runSql :: SqlT IO a -> IO a
    runSql =  flip runSqlPersistM connection

    runSqlProperty :: SqlT IO Property -> Property
    runSqlProperty action = ioProperty . runSql $ do
        prop <- action
        liftIO $ putStrLn "\nDB reset code (per test) goes here\n"
        return prop

    quickCheckSql :: PropertyM (SqlT IO) () -> IO ()
    quickCheckSql = quickCheck . monadic runSqlProperty

  -- Initial DB setup code
  runSql $ runMigration migrateAll

  -- Test as many quickcheck properties as you like
  quickCheckSql prop_insert_person

The full code including imports and extensions can be found in this gist .

Note that I did not implement the functionality to clean the database between tests, as I do not know how to do that in general with persistent, you will have to implement that yourself (replace the placeholder cleanup action that just prints a message right now).

---

You should also not need instances for MonadCatch / MonadThrow for PropertyM . Instead, you should catch in the NwApp monad. So instead of this:

let test = do
  run a
  ...
  run b
test `catch` \exc -> ...

you should use the following code instead:

let test = do
  a
  b
  return ...whether or not the test was successfull...
let testCaught = test `catch` \exc -> ..handler code...
ok <- test
assert ok

Answer 2

( .lhs available at: http://lpaste.net/173182 )

Packages used:

build-depends: base >= 4.7 && < 5, QuickCheck, persistent, persistent-sqlite, monad-logger, transformers

First, some imports:

 {-# LANGUAGE OverloadedStrings #-}

 module Lib2 where

 import Database.Persist.Sql
 import Database.Persist.Sqlite
 import Test.QuickCheck
 import Test.QuickCheck.Monadic
 import Control.Monad.Logger
 import Control.Monad.Trans.Class

Here is the query we want to test:

 aQuery :: SqlPersistM Int
 aQuery = undefined

Of course, aQuery may take arguments. The important thing is that it returns a SqlPersistM action.

Here is how you can run a SqlPersistM action:

 runQuery = runSqlite ":memory:" $ do aQuery

Even though PropertyM is a monad transformer, it appears that the only useful way to use it is with PropertyM IO .

In order to get an IO-action out of a SqlPersistM-action, we need the backend.

With these in mind, here is an example database test:

 prop_test :: SqlBackend -> PropertyM IO Bool
 prop_test backend = do
   a <- run $ runSqlPersistM aQuery backend
   b <- run $ runSqlPersistM aQuery backend
   return (a == b)

Here run is the same as lift .

To run an SqlPersistM action with a specific backend, we need to perform some lifting:

 runQuery2 = withSqliteConn ":memory:" $ \backend -> do
               liftNoLogging (runSqlPersistM aQuery backend)

 liftNoLogging :: Monad m => m a -> NoLoggingT m a
 liftNoLogging = lift

Explanation:

• runSqlPersistM aQuery backend is an IO-action
• but withSqliteConn ... requires a monadic action that has logging
• so we lift the IO-action to a NoLoggingT IO-action with the liftNoLogging function

Finally, to run prop_test via quickCheck:

 runTest = withSqliteConn ":memory:" $ \backend -> do
             liftNoLogging $ quickCheck (monadicIO (prop_test backend))

Answer 3

monadicIO :: PropertyM IO a -> Property
runSqlite ":memory:" :: SqlPersistT (NoLoggingT (ResourceT m)) a -> m a
prop_childCreation :: PropertyM NwApp Bool

These won't compose. One of these doesn't belong.

monadic :: Monad m => (m Property -> Property) -> PropertyM m a -> Property

This looks better than monadicIO : We can combine this and our requirement to use prop_childCreation into a requirement to produce (m Property -> Property).

runSqlite ":memory:" :: SqlPersistT (NoLoggingT (ResourceT m)) a -> m a
\f -> monadic f prop_childCreation :: (NwApp Property -> Property) -> Property

Rewrite NwApp to ease the looking up:

runSqlite ":memory:" :: SqlPersistT (NoLoggingT (ResourceT m)) a -> m a
\f -> monadic f prop_childCreation :: (SqlPersistT IO Property -> Property) -> Property

I'll just trust that everything with T at the end is a MonadTrans , meaning we have lift :: Monad m => ma -> T ma . Then we can see that this is our chance to get rid of SqlPersistT:

\f g -> monadic (f . runSqlite ":memory:" . g) prop_childCreation :: (IO Property -> Property) -> (SqlPersistT IO Property -> SqlPersistT (NoLoggingT (ResourceT m)) Property) -> Property

We'll need to get rid of the IO somewhere again, so monadicIO might help us:

\f g -> monadic (monadicIO . f . runSqlite ":memory:" . g) prop_childCreation :: (IO Property -> PropertyT IO a) -> (SqlPersistT IO Property -> SqlPersistT (NoLoggingT (ResourceT m)) Property) -> Property

Time for lift to shine! Except that in f we apparently throw the Property in IO Property away, and on the right we need to "fmap" into the monad argument part of SqlPersistT somehow. Well, we can ignore the first problem and defer the other to the next step:

\f -> monadic (monadicIO . lift . runSqlite ":memory:" . f (lift . lift)) prop_childCreation :: ((m a -> n a) -> SqlPersistT m a -> SqlPersist n a) -> Property

Turns out this looks just like what Control.Monad.Morph 's MFunctor provides. I'll just pretend SqlPersistT had an instance of that:

monadic (monadicIO . lift . runSqlite ":memory:" . mmorph (lift . lift)) prop_childCreation :: Property

Tada! Good luck in your quest, maybe this'll help a little.

The exference project attempts to automate the process I just walked through. I've heard that putting _ whereever I put arguments like f and g will make ghc tell you what type should go there.