{-# 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 =
  (Result -> Result) -> prop -> Property
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult ((Result -> Result) -> prop -> Property)
-> (Result -> Result) -> prop -> Property
forall a b. (a -> b) -> a -> b
$ \Result
res -> Result
res {maybeNumTests = (n *) <$> (maybeNumTests res <|> Just 100)}

testPropertyN :: Testable prop => Int -> TestName -> prop -> TestTree
testPropertyN :: forall prop. Testable prop => Int -> TestName -> prop -> TestTree
testPropertyN Int
n TestName
name = TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
name (Property -> TestTree) -> (prop -> Property) -> prop -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> prop -> Property
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 ([TestTree] -> TestTree)
-> ([Laws] -> [TestTree]) -> [Laws] -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Laws -> TestTree) -> [Laws] -> [TestTree]
forall a b. (a -> b) -> [a] -> [b]
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 :: TestName
lawsProperties :: [(TestName, Property)]
lawsTypeclass :: Laws -> TestName
lawsProperties :: Laws -> [(TestName, Property)]
..} =
      TestName -> [TestTree] -> TestTree
testGroup TestName
lawsTypeclass ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ ((TestName, Property) -> TestTree)
-> [(TestName, Property)] -> [TestTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TestName -> Property -> TestTree)
-> (TestName, Property) -> TestTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty) [(TestName, Property)]
lawsProperties