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

Question

我需要测试很多访问数据库的函数（通过 Persistent）。虽然我可以使用monadicIO 和withSqlitePool 来做到这一点，但它会导致测试效率低下。每个测试，而不是属性，而是测试，都会创建和销毁数据库池。如何防止这种情况发生？

重要：忘记效率或优雅。我什至无法使QuickCheck 和Persistent 类型组合起来。

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

为避免创建和销毁数据库池并且只设置一次数据库，您需要在外部的main 函数中使用withSqliteConn，然后转换每个属性以使用该连接，如以下代码所示：

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

包含导入和扩展的完整代码可以在in this gist找到。

请注意，我没有实现在测试之间清理数据库的功能，因为我不知道通常如何使用持久化来执行此操作，您必须自己实现（替换仅打印消息的占位符清理操作现在）。

---

您也不应该需要 MonadCatch 的实例/PropertyM 的 MonadThrow 实例。相反，您应该在 NwApp monad 中捕获。所以不要这样：

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

您应该改用以下代码：

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 位于：http://lpaste.net/173182）

使用的包：

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

首先，一些导入：

 {-# 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

这是我们要测试的查询：

 aQuery :: SqlPersistM Int
 aQuery = undefined

当然，aQuery 可以接受参数。重要的是 它返回一个SqlPersistM 操作。

以下是运行SqlPersistM 操作的方法：

 runQuery = runSqlite ":memory:" $ do aQuery

尽管PropertyM 是一个单子转换器，但似乎唯一的 使用它的有用方法是使用PropertyM IO。

为了从 SqlPersistM-action 中获取 IO-action，我们需要 后端。

考虑到这些，这里是一个示例数据库测试：

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

这里run与lift相同。

要使用特定后端运行 SqlPersistM 操作，我们需要 进行一些提升：

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

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

解释：

• runSqlPersistM aQuery backend 是一个 IO 动作
• 但withSqliteConn ... 需要一个具有日志记录的单子操作
• 所以我们使用 liftNoLogging 函数将 IO-action 提升为 NoLoggingT IO-action

最后，通过 quickCheck 运行 prop_test：

 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

这些不会组成。其中之一不属于。

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

这看起来比monadicIO 更好：我们可以将这个和我们使用 prop_childCreation 的要求结合到生产（m Property -> Property）的要求中。

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

重写 NwApp 以方便查找：

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

我相信最后带有T 的所有内容都是MonadTrans，这意味着我们有lift :: Monad m => m a -> T m a。然后我们可以看到这是我们摆脱 SqlPersistT 的机会：

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

我们需要在某个地方再次摆脱 IO，所以 monadicIO 可能会帮助我们：

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

是时候让电梯大放异彩了！除了在 f 中，我们显然将 IO Property 中的 Property 扔掉了，而在右边，我们需要以某种方式“fmap”到 SqlPersistT 的 monad 参数部分。好吧，我们可以忽略第一个问题，将另一个问题推迟到下一步：

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

原来这看起来就像Control.Monad.Morph 的MFunctor 提供的一样。我会假装 SqlPersistT 有一个这样的实例：

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

Tada!祝你的任务好运，也许这会有所帮助。

exference 项目试图自动化我刚刚完成的过程。我听说将 _ 放在我放置 f 和 g 之类的参数的任何位置都会让 ghc 告诉你应该放什么类型。