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

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

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

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 -> String -> prop -> Spec
testPropertyN :: forall prop. Testable prop => Int -> String -> prop -> Spec
testPropertyN Int
n String
name = String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
name (Property -> Spec) -> (prop -> Property) -> prop -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> prop -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxTimesSuccess Int
n

testLawsGroup :: String -> [Laws] -> Spec
testLawsGroup :: String -> [Laws] -> Spec
testLawsGroup String
name = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
name (Spec -> Spec) -> ([Laws] -> Spec) -> [Laws] -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Laws -> Spec) -> [Laws] -> Spec
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Laws -> Spec
testLaws
  where
    testLaws :: Laws -> Spec
testLaws Laws {String
[(String, Property)]
lawsTypeclass :: String
lawsProperties :: [(String, Property)]
lawsTypeclass :: Laws -> String
lawsProperties :: Laws -> [(String, Property)]
..} =
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
lawsTypeclass (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ ((String, Property) -> Spec) -> [(String, Property)] -> Spec
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((String -> Property -> Spec) -> (String, Property) -> Spec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop) [(String, Property)]
lawsProperties