{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}

module Test.Common (
  testLawsGroup,
  testPropertyN,
  withMaxTimesSuccess,
  module X,
)
where

import Control.Applicative
import Data.Proxy as X
import Test.QuickCheck.Classes.Base as X
import Test.QuickCheck.Property (mapTotalResult, maybeNumTests)
import Test.Tasty as X
import Test.Tasty.QuickCheck as X

withMaxTimesSuccess :: Testable prop => Int -> prop -> Property
withMaxTimesSuccess :: forall prop. Testable prop => Int -> prop -> Property
withMaxTimesSuccess !Int
n =
  forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult forall a b. (a -> b) -> a -> b
$ \Result
res -> Result
res {maybeNumTests :: Maybe Int
maybeNumTests = (Int
n forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Result -> Maybe Int
maybeNumTests Result
res forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just Int
100)}

testPropertyN :: Testable prop => Int -> TestName -> prop -> TestTree
testPropertyN :: forall prop. Testable prop => Int -> TestName -> prop -> TestTree
testPropertyN Int
n TestName
name = forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => Int -> prop -> Property
withMaxTimesSuccess Int
n

testLawsGroup :: TestName -> [Laws] -> TestTree
testLawsGroup :: TestName -> [Laws] -> TestTree
testLawsGroup TestName
name = TestName -> [TestTree] -> TestTree
testGroup TestName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Laws -> TestTree
testLaws
  where
    testLaws :: Laws -> TestTree
testLaws Laws {TestName
[(TestName, Property)]
lawsTypeclass :: Laws -> TestName
lawsProperties :: Laws -> [(TestName, Property)]
lawsProperties :: [(TestName, Property)]
lawsTypeclass :: TestName
..} =
      TestName -> [TestTree] -> TestTree
testGroup TestName
lawsTypeclass forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Testable a => TestName -> a -> TestTree
testProperty) [(TestName, Property)]
lawsProperties