Haskell の QuickCheck を自動化する

ライブラリを開発していると、複数のテストを一挙に回したくなるかもしれませんね。そんなときはこうします。

{-# LANGUAGE TemplateHaskell #-}

import Data.List
import Test.QuickCheck

-- 与えられた２つのリストを連結する
cat :: (Eq a) => [a] -> [a] -> [a]
cat [] ys = ys
cat (x:xs) ys = x : (xs `cat` ys)

-- cat が結合律を満たすかどうかのテスト
prop_cat xs ys zs = (xs `cat` ys) `cat` zs == xs `cat` (ys `cat` zs)

-- 最初のリストから二番目のリストの要素を除去したリストを作る
sub :: (Eq a) => [a] -> [a] -> [a]
sub [] ys = []
sub (x:xs) ys | x `elem` ys = xs `sub` ys
| otherwise = x : (xs `sub` ys)

-- sub が結合律を満たすかどうかのテスト
prop_sub xs ys zs = (xs `sub` ys) `sub` zs == xs `sub` (ys `sub` zs)
--to run this test, > quickCheck prop_cap

--最初のリストに含まれている要素を除外しつつ２つの与えられたリストをマージする
ucat :: (Eq a) => [a] -> [a] -> [a]
ucat [] ys = ys
ucat (x:xs) ys | x `elem` ys = x : (xs `ucat` (ys `sub` [x]))
| otherwise = x : (xs `ucat` ys)

-- ucat が結合律を満たすかどうかのテスト
prop_ucat xs ys zs = (xs `ucat` ys) `ucat` zs == xs `ucat` (ys `ucat` zs)

return []
main = $forAllProperties (quickCheckWithResult stdArgs { maxSuccess = 2000 })


■動かし方／その出力例

$ stack runghc qc.hs
Run from outside a project, using implicit global project config
=== prop_cat from qc.hs:12 ===
+++ OK, passed 2000 tests.

=== prop_sub from qc.hs:20 ===
*** Failed! Falsifiable (after 9 tests and 7 shrinks):
[0]
[]
[0]

=== prop_ucat from qc.hs:29 ===
+++ OK, passed 2000 tests.

■コードの解説
cat, sub, ucat というリスト演算を定義し、それらが結合法則を満たすかどうかチェックしています。テストの結果、cat は合格、subは失格（つまり結合法則の反例が見つかった）、ucatは合格となりました。

■ポイント
1. TemplateHaskell　を使う。
2. テストの名前は prop_ で始まる。　（TemplateHaskellを使っていることからの制約）
3. return[] とかいうキモいやつは我慢。　（TemplateHaskellを使っていることからの制約）
4. main は一番最後に来る。　（TemplateHaskellを使っていることからの制約）

differentialengineの投稿 (2017/01/24)

https://differentialengine.wordpress.com/2017/01/24/automatic-tests-with-quickcheck/