如何使用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

爲了避免創建和銷燬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單子。因此，而不是這樣的：

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

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中，我們明顯地將Property丟在IO 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告訴你什麼類型應該去那裏。使用

套餐：

Answer 3

（http://lpaste.net/173182可在.lhs）：

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動作中獲得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 ...需要具有日誌記錄功能的monadic操作
• 因此，我們將IO操作提升爲NoLoggingT IO操作，並使用liftNoLogging功能

最後，通過快速檢查prop_test運行：

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