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

为了避免创建和销毁数据库池并且只设置一次数据库，您需要使用withSqliteConn在您的 main在外部调用函数，然后转换每个属性以使用该连接，如下代码所示:

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