如何使用QuickCheck测试数据库相关功能？
How to use QuickCheck to test database related functions?
我需要测试很多访问数据库的函数（通过 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
为了避免创建和销毁 DB 池并且只设置一次 DB，您需要在外部的 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 / MonadThrow PropertyM 的实例。相反，您应该抓住 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
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 属性 -> 属性)。
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 告诉你应该放什么类型。
（.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可以带参数。重要的是
它 returns 一个 SqlPersistM 动作。
您可以通过以下方式 运行 执行 SqlPersistM 操作：
runQuery = runSqlite ":memory:" $ do aQuery
尽管 PropertyM 是一个 monad 转换器，但似乎唯一的
使用它的有用方法是 PropertyM IO.
为了从 SqlPersistM 操作中获取 IO 操作，我们需要
后端。
考虑到这些，下面是一个数据库测试示例：
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 操作提升为 NoLoggingT IO 操作
最后，通过 quickCheck 运行 prop_test：
runTest = withSqliteConn ":memory:" $ \backend -> do
liftNoLogging $ quickCheck (monadicIO (prop_test backend))
我需要测试很多访问数据库的函数（通过 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
为了避免创建和销毁 DB 池并且只设置一次 DB，您需要在外部的 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 / MonadThrow PropertyM 的实例。相反，您应该抓住 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
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 属性 -> 属性)。
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 告诉你应该放什么类型。
（.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可以带参数。重要的是
它 returns 一个 SqlPersistM 动作。
您可以通过以下方式 运行 执行 SqlPersistM 操作：
runQuery = runSqlite ":memory:" $ do aQuery
尽管 PropertyM 是一个 monad 转换器，但似乎唯一的
使用它的有用方法是 PropertyM IO.
为了从 SqlPersistM 操作中获取 IO 操作，我们需要 后端。
考虑到这些，下面是一个数据库测试示例：
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 操作提升为 NoLoggingT IO 操作
最后，通过 quickCheck 运行 prop_test：
runTest = withSqliteConn ":memory:" $ \backend -> do
liftNoLogging $ quickCheck (monadicIO (prop_test backend))