如何使用QuickCheck測試數據庫相關的功能？

Question

我需要測試許多訪問數據庫的函數（通過Persistent）。 雖然我可以使用monadicIO和withSqlitePool來執行此操作， 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

完整的代碼包括導入和擴展可以在這個要點中找到。

請注意，我沒有實現在測試之間清理數據庫的功能，因為我不知道如何通常使用持久性，你必須自己實現（替換剛剛打印消息的占位符清理操作） 。

---

對於PropertyM您也不需要MonadCatch / 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是monad變換器，但似乎唯一有用的方法是使用PropertyM IO 。

為了從SqlPersistM-action中獲取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 ...需要一個具有日志記錄的withSqliteConn ...動作
• 所以我們使用liftNoLogging函數將IO動作提升到NoLoggingT IO動作

最后，通過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 => ma -> T ma 。 然后我們可以看到這是我們擺脫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

田田！ 祝你好運，也許這會有所幫助。

exference項目試圖使我剛剛完成的過程自動化。 我聽說過，只要我把f和g之類的參數放進去，就會讓ghc告訴你應該去哪種類型。