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
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
( .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-actionwithSqliteConn ...
requires a monadic action that has loggingliftNoLogging
functionFinally, to run prop_test via quickCheck:
runTest = withSqliteConn ":memory:" $ \backend -> do
liftNoLogging $ quickCheck (monadicIO (prop_test backend))
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With