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-action withSqliteConn ...
requires a monadic action that has logging liftNoLogging
function Finally, to run prop_test via quickCheck:
runTest = withSqliteConn ":memory:" $ \backend -> do
liftNoLogging $ quickCheck (monadicIO (prop_test backend))
monadicIO :: PropertyM IO a -> Property
runSqlite ":memory:" :: SqlPersistT (NoLoggingT (ResourceT m)) a -> m a
prop_childCreation :: PropertyM NwApp Bool
These won't compose. One of these doesn't belong.
monadic :: Monad m => (m Property -> Property) -> PropertyM m a -> Property
This looks better than monadicIO
: We can combine this and our requirement to use prop_childCreation into a requirement to produce (m Property -> Property).
runSqlite ":memory:" :: SqlPersistT (NoLoggingT (ResourceT m)) a -> m a
\f -> monadic f prop_childCreation :: (NwApp Property -> Property) -> Property
Rewrite NwApp to ease the looking up:
runSqlite ":memory:" :: SqlPersistT (NoLoggingT (ResourceT m)) a -> m a
\f -> monadic f prop_childCreation :: (SqlPersistT IO Property -> Property) -> Property
I'll just trust that everything with T
at the end is a MonadTrans
, meaning we have lift :: Monad m => ma -> T ma
. Then we can see that this is our chance to get rid of SqlPersistT:
\f g -> monadic (f . runSqlite ":memory:" . g) prop_childCreation :: (IO Property -> Property) -> (SqlPersistT IO Property -> SqlPersistT (NoLoggingT (ResourceT m)) Property) -> Property
We'll need to get rid of the IO somewhere again, so monadicIO might help us:
\f g -> monadic (monadicIO . f . runSqlite ":memory:" . g) prop_childCreation :: (IO Property -> PropertyT IO a) -> (SqlPersistT IO Property -> SqlPersistT (NoLoggingT (ResourceT m)) Property) -> Property
Time for lift to shine! Except that in f we apparently throw the Property
in IO Property
away, and on the right we need to "fmap" into the monad argument part of SqlPersistT somehow. Well, we can ignore the first problem and defer the other to the next step:
\f -> monadic (monadicIO . lift . runSqlite ":memory:" . f (lift . lift)) prop_childCreation :: ((m a -> n a) -> SqlPersistT m a -> SqlPersist n a) -> Property
Turns out this looks just like what Control.Monad.Morph
's MFunctor
provides. I'll just pretend SqlPersistT had an instance of that:
monadic (monadicIO . lift . runSqlite ":memory:" . mmorph (lift . lift)) prop_childCreation :: Property
Tada! Good luck in your quest, maybe this'll help a little.
The exference project attempts to automate the process I just walked through. I've heard that putting _ whereever I put arguments like f and g will make ghc tell you what type should go there.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.