{-# LANGUAGE RankNTypes #-}
module Test.Lawful.QuickCheck
(
testLaws,
testLawsWith,
forAll,
forAllShow,
toProperty,
)
where
import Control.Monad.Trans.Class (MonadTrans, lift)
import Test.Lawful.Types (Law, Laws)
import Test.QuickCheck (Gen, Property, discard)
import qualified Test.QuickCheck as Q
import Test.QuickCheck.Monadic (PropertyM (MkPropertyM), assert, monadicIO, pick)
import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
toProperty :: (forall a. m a -> PropertyM IO a) -> Law m -> Property
toProperty :: forall (m :: * -> *).
(forall a. m a -> PropertyM IO a) -> Law m -> Property
toProperty forall a. m a -> PropertyM IO a
run Law m
law = forall a. Testable a => PropertyM IO a -> Property
monadicIO forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a
discard forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
assert forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. m a -> PropertyM IO a
run Law m
law
testLaws :: TestName -> (forall a. m a -> PropertyM IO a) -> Laws m -> TestTree
testLaws :: forall (m :: * -> *).
TestName -> (forall a. m a -> PropertyM IO a) -> Laws m -> TestTree
testLaws = forall (m :: * -> *).
(Property -> Property)
-> TestName
-> (forall a. m a -> PropertyM IO a)
-> Laws m
-> TestTree
testLawsWith forall a. a -> a
id
testLawsWith :: (Property -> Property) -> TestName -> (forall a. m a -> PropertyM IO a) -> Laws m -> TestTree
testLawsWith :: forall (m :: * -> *).
(Property -> Property)
-> TestName
-> (forall a. m a -> PropertyM IO a)
-> Laws m
-> TestTree
testLawsWith Property -> Property
fn TestName
name forall a. m a -> PropertyM IO a
run Laws m
laws = TestName -> [TestTree] -> TestTree
testGroup TestName
name [forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
n (Property -> Property
fn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(forall a. m a -> PropertyM IO a) -> Law m -> Property
toProperty forall a. m a -> PropertyM IO a
run Law m
l) | (TestName
n, Law m
l) <- Laws m
laws]
forAll :: (MonadTrans t, Monad m, Show a) => Gen a -> t (PropertyM m) a
forAll :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m, Show a) =>
Gen a -> t (PropertyM m) a
forAll = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (Monad m, Show a) => Gen a -> PropertyM m a
pick
forAllShow :: (MonadTrans t, Monad m) => (a -> String) -> Gen a -> t (PropertyM m) a
forAllShow :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
(a -> TestName) -> Gen a -> t (PropertyM m) a
forAllShow a -> TestName
shw = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *}. Functor m => Gen a -> PropertyM m a
pickShow
where
pickShow :: Gen a -> PropertyM m a
pickShow Gen a
gen = forall (m :: * -> *) a.
((a -> Gen (m Property)) -> Gen (m Property)) -> PropertyM m a
MkPropertyM forall a b. (a -> b) -> a -> b
$ \a -> Gen (m Property)
k -> do
a
a <- Gen a
gen
m Property
mp <- a -> Gen (m Property)
k a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
Q.forAllShow (forall (m :: * -> *) a. Monad m => a -> m a
return a
a) a -> TestName
shw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Property
mp