-- | This module allows to use SmallCheck properties in tasty.
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,
             TypeOperators, DeriveDataTypeable, TypeFamilies,
             GeneralizedNewtypeDeriving #-}
module Test.Tasty.SmallCheck
  ( testProperty
  , SmallCheckDepth(..)
  , module Test.SmallCheck
  ) where

import Test.Tasty.Providers
import Test.Tasty.Options
import qualified Test.SmallCheck as SC
import Test.SmallCheck hiding (smallCheck) -- for re-export
import Test.SmallCheck.Drivers as SC
import Control.Exception
import Control.Monad (when)
import Data.Typeable
import Data.IORef
import Options.Applicative (metavar)
import Text.Printf

-- | Create a 'Test' for a SmallCheck 'SC.Testable' property
testProperty :: SC.Testable IO a => TestName -> a -> TestTree
testProperty :: TestName -> a -> TestTree
testProperty TestName
name a
prop = TestName -> Property IO -> TestTree
forall t. IsTest t => TestName -> t -> TestTree
singleTest TestName
name (Property IO -> TestTree) -> Property IO -> TestTree
forall a b. (a -> b) -> a -> b
$ (a -> Property IO
forall (m :: * -> *) a. Testable m a => a -> Property m
SC.test a
prop :: SC.Property IO)

-- | The \"depth\" parameter for SmallCheck
newtype SmallCheckDepth = SmallCheckDepth Int
  deriving (Integer -> SmallCheckDepth
SmallCheckDepth -> SmallCheckDepth
SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
(SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth)
-> (Integer -> SmallCheckDepth)
-> Num SmallCheckDepth
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SmallCheckDepth
$cfromInteger :: Integer -> SmallCheckDepth
signum :: SmallCheckDepth -> SmallCheckDepth
$csignum :: SmallCheckDepth -> SmallCheckDepth
abs :: SmallCheckDepth -> SmallCheckDepth
$cabs :: SmallCheckDepth -> SmallCheckDepth
negate :: SmallCheckDepth -> SmallCheckDepth
$cnegate :: SmallCheckDepth -> SmallCheckDepth
* :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$c* :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
- :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$c- :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
+ :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$c+ :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
Num, Eq SmallCheckDepth
Eq SmallCheckDepth
-> (SmallCheckDepth -> SmallCheckDepth -> Ordering)
-> (SmallCheckDepth -> SmallCheckDepth -> Bool)
-> (SmallCheckDepth -> SmallCheckDepth -> Bool)
-> (SmallCheckDepth -> SmallCheckDepth -> Bool)
-> (SmallCheckDepth -> SmallCheckDepth -> Bool)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> Ord SmallCheckDepth
SmallCheckDepth -> SmallCheckDepth -> Bool
SmallCheckDepth -> SmallCheckDepth -> Ordering
SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$cmin :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
max :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$cmax :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
>= :: SmallCheckDepth -> SmallCheckDepth -> Bool
$c>= :: SmallCheckDepth -> SmallCheckDepth -> Bool
> :: SmallCheckDepth -> SmallCheckDepth -> Bool
$c> :: SmallCheckDepth -> SmallCheckDepth -> Bool
<= :: SmallCheckDepth -> SmallCheckDepth -> Bool
$c<= :: SmallCheckDepth -> SmallCheckDepth -> Bool
< :: SmallCheckDepth -> SmallCheckDepth -> Bool
$c< :: SmallCheckDepth -> SmallCheckDepth -> Bool
compare :: SmallCheckDepth -> SmallCheckDepth -> Ordering
$ccompare :: SmallCheckDepth -> SmallCheckDepth -> Ordering
$cp1Ord :: Eq SmallCheckDepth
Ord, SmallCheckDepth -> SmallCheckDepth -> Bool
(SmallCheckDepth -> SmallCheckDepth -> Bool)
-> (SmallCheckDepth -> SmallCheckDepth -> Bool)
-> Eq SmallCheckDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmallCheckDepth -> SmallCheckDepth -> Bool
$c/= :: SmallCheckDepth -> SmallCheckDepth -> Bool
== :: SmallCheckDepth -> SmallCheckDepth -> Bool
$c== :: SmallCheckDepth -> SmallCheckDepth -> Bool
Eq, Num SmallCheckDepth
Ord SmallCheckDepth
Num SmallCheckDepth
-> Ord SmallCheckDepth
-> (SmallCheckDepth -> Rational)
-> Real SmallCheckDepth
SmallCheckDepth -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: SmallCheckDepth -> Rational
$ctoRational :: SmallCheckDepth -> Rational
$cp2Real :: Ord SmallCheckDepth
$cp1Real :: Num SmallCheckDepth
Real, Int -> SmallCheckDepth
SmallCheckDepth -> Int
SmallCheckDepth -> [SmallCheckDepth]
SmallCheckDepth -> SmallCheckDepth
SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
SmallCheckDepth
-> SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
(SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth)
-> (Int -> SmallCheckDepth)
-> (SmallCheckDepth -> Int)
-> (SmallCheckDepth -> [SmallCheckDepth])
-> (SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth])
-> (SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth])
-> (SmallCheckDepth
    -> SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth])
-> Enum SmallCheckDepth
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SmallCheckDepth
-> SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
$cenumFromThenTo :: SmallCheckDepth
-> SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
enumFromTo :: SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
$cenumFromTo :: SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
enumFromThen :: SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
$cenumFromThen :: SmallCheckDepth -> SmallCheckDepth -> [SmallCheckDepth]
enumFrom :: SmallCheckDepth -> [SmallCheckDepth]
$cenumFrom :: SmallCheckDepth -> [SmallCheckDepth]
fromEnum :: SmallCheckDepth -> Int
$cfromEnum :: SmallCheckDepth -> Int
toEnum :: Int -> SmallCheckDepth
$ctoEnum :: Int -> SmallCheckDepth
pred :: SmallCheckDepth -> SmallCheckDepth
$cpred :: SmallCheckDepth -> SmallCheckDepth
succ :: SmallCheckDepth -> SmallCheckDepth
$csucc :: SmallCheckDepth -> SmallCheckDepth
Enum, Enum SmallCheckDepth
Real SmallCheckDepth
Real SmallCheckDepth
-> Enum SmallCheckDepth
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth)
-> (SmallCheckDepth
    -> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth))
-> (SmallCheckDepth
    -> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth))
-> (SmallCheckDepth -> Integer)
-> Integral SmallCheckDepth
SmallCheckDepth -> Integer
SmallCheckDepth
-> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth)
SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: SmallCheckDepth -> Integer
$ctoInteger :: SmallCheckDepth -> Integer
divMod :: SmallCheckDepth
-> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth)
$cdivMod :: SmallCheckDepth
-> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth)
quotRem :: SmallCheckDepth
-> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth)
$cquotRem :: SmallCheckDepth
-> SmallCheckDepth -> (SmallCheckDepth, SmallCheckDepth)
mod :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$cmod :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
div :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$cdiv :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
rem :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$crem :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
quot :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$cquot :: SmallCheckDepth -> SmallCheckDepth -> SmallCheckDepth
$cp2Integral :: Enum SmallCheckDepth
$cp1Integral :: Real SmallCheckDepth
Integral, Typeable)

instance IsOption SmallCheckDepth where
  defaultValue :: SmallCheckDepth
defaultValue = SmallCheckDepth
5
  parseValue :: TestName -> Maybe SmallCheckDepth
parseValue = (Int -> SmallCheckDepth) -> Maybe Int -> Maybe SmallCheckDepth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> SmallCheckDepth
SmallCheckDepth (Maybe Int -> Maybe SmallCheckDepth)
-> (TestName -> Maybe Int) -> TestName -> Maybe SmallCheckDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Int
forall a. Read a => TestName -> Maybe a
safeRead
  optionName :: Tagged SmallCheckDepth TestName
optionName = TestName -> Tagged SmallCheckDepth TestName
forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"smallcheck-depth"
  optionHelp :: Tagged SmallCheckDepth TestName
optionHelp = TestName -> Tagged SmallCheckDepth TestName
forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"Depth to use for smallcheck tests"
  optionCLParser :: Parser SmallCheckDepth
optionCLParser = Mod OptionFields SmallCheckDepth -> Parser SmallCheckDepth
forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (Mod OptionFields SmallCheckDepth -> Parser SmallCheckDepth)
-> Mod OptionFields SmallCheckDepth -> Parser SmallCheckDepth
forall a b. (a -> b) -> a -> b
$ TestName -> Mod OptionFields SmallCheckDepth
forall (f :: * -> *) a. HasMetavar f => TestName -> Mod f a
metavar TestName
"NUMBER"

-- | The maximum number of test cases to generate. Can be used as an
-- alternative to setting 'SmallCheckDepth'.
newtype SmallCheckMaxCount = SmallCheckMaxCount Int
  deriving (Integer -> SmallCheckMaxCount
SmallCheckMaxCount -> SmallCheckMaxCount
SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
(SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount)
-> (Integer -> SmallCheckMaxCount)
-> Num SmallCheckMaxCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SmallCheckMaxCount
$cfromInteger :: Integer -> SmallCheckMaxCount
signum :: SmallCheckMaxCount -> SmallCheckMaxCount
$csignum :: SmallCheckMaxCount -> SmallCheckMaxCount
abs :: SmallCheckMaxCount -> SmallCheckMaxCount
$cabs :: SmallCheckMaxCount -> SmallCheckMaxCount
negate :: SmallCheckMaxCount -> SmallCheckMaxCount
$cnegate :: SmallCheckMaxCount -> SmallCheckMaxCount
* :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$c* :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
- :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$c- :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
+ :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$c+ :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
Num, Eq SmallCheckMaxCount
Eq SmallCheckMaxCount
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> Ordering)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> Bool)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> Bool)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> Bool)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> Bool)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> Ord SmallCheckMaxCount
SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
SmallCheckMaxCount -> SmallCheckMaxCount -> Ordering
SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$cmin :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
max :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$cmax :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
>= :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
$c>= :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
> :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
$c> :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
<= :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
$c<= :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
< :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
$c< :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
compare :: SmallCheckMaxCount -> SmallCheckMaxCount -> Ordering
$ccompare :: SmallCheckMaxCount -> SmallCheckMaxCount -> Ordering
$cp1Ord :: Eq SmallCheckMaxCount
Ord, SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
(SmallCheckMaxCount -> SmallCheckMaxCount -> Bool)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> Bool)
-> Eq SmallCheckMaxCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
$c/= :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
== :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
$c== :: SmallCheckMaxCount -> SmallCheckMaxCount -> Bool
Eq, Num SmallCheckMaxCount
Ord SmallCheckMaxCount
Num SmallCheckMaxCount
-> Ord SmallCheckMaxCount
-> (SmallCheckMaxCount -> Rational)
-> Real SmallCheckMaxCount
SmallCheckMaxCount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: SmallCheckMaxCount -> Rational
$ctoRational :: SmallCheckMaxCount -> Rational
$cp2Real :: Ord SmallCheckMaxCount
$cp1Real :: Num SmallCheckMaxCount
Real, Int -> SmallCheckMaxCount
SmallCheckMaxCount -> Int
SmallCheckMaxCount -> [SmallCheckMaxCount]
SmallCheckMaxCount -> SmallCheckMaxCount
SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
SmallCheckMaxCount
-> SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
(SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount)
-> (Int -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> Int)
-> (SmallCheckMaxCount -> [SmallCheckMaxCount])
-> (SmallCheckMaxCount
    -> SmallCheckMaxCount -> [SmallCheckMaxCount])
-> (SmallCheckMaxCount
    -> SmallCheckMaxCount -> [SmallCheckMaxCount])
-> (SmallCheckMaxCount
    -> SmallCheckMaxCount
    -> SmallCheckMaxCount
    -> [SmallCheckMaxCount])
-> Enum SmallCheckMaxCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SmallCheckMaxCount
-> SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
$cenumFromThenTo :: SmallCheckMaxCount
-> SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
enumFromTo :: SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
$cenumFromTo :: SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
enumFromThen :: SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
$cenumFromThen :: SmallCheckMaxCount -> SmallCheckMaxCount -> [SmallCheckMaxCount]
enumFrom :: SmallCheckMaxCount -> [SmallCheckMaxCount]
$cenumFrom :: SmallCheckMaxCount -> [SmallCheckMaxCount]
fromEnum :: SmallCheckMaxCount -> Int
$cfromEnum :: SmallCheckMaxCount -> Int
toEnum :: Int -> SmallCheckMaxCount
$ctoEnum :: Int -> SmallCheckMaxCount
pred :: SmallCheckMaxCount -> SmallCheckMaxCount
$cpred :: SmallCheckMaxCount -> SmallCheckMaxCount
succ :: SmallCheckMaxCount -> SmallCheckMaxCount
$csucc :: SmallCheckMaxCount -> SmallCheckMaxCount
Enum, Enum SmallCheckMaxCount
Real SmallCheckMaxCount
Real SmallCheckMaxCount
-> Enum SmallCheckMaxCount
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount)
-> (SmallCheckMaxCount
    -> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount))
-> (SmallCheckMaxCount
    -> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount))
-> (SmallCheckMaxCount -> Integer)
-> Integral SmallCheckMaxCount
SmallCheckMaxCount -> Integer
SmallCheckMaxCount
-> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount)
SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: SmallCheckMaxCount -> Integer
$ctoInteger :: SmallCheckMaxCount -> Integer
divMod :: SmallCheckMaxCount
-> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount)
$cdivMod :: SmallCheckMaxCount
-> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount)
quotRem :: SmallCheckMaxCount
-> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount)
$cquotRem :: SmallCheckMaxCount
-> SmallCheckMaxCount -> (SmallCheckMaxCount, SmallCheckMaxCount)
mod :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$cmod :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
div :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$cdiv :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
rem :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$crem :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
quot :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$cquot :: SmallCheckMaxCount -> SmallCheckMaxCount -> SmallCheckMaxCount
$cp2Integral :: Enum SmallCheckMaxCount
$cp1Integral :: Real SmallCheckMaxCount
Integral, Typeable)

instance IsOption SmallCheckMaxCount where
  defaultValue :: SmallCheckMaxCount
defaultValue = Int -> SmallCheckMaxCount
SmallCheckMaxCount Int
forall a. Bounded a => a
maxBound -- disable by default
  parseValue :: TestName -> Maybe SmallCheckMaxCount
parseValue = (Int -> SmallCheckMaxCount)
-> Maybe Int -> Maybe SmallCheckMaxCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> SmallCheckMaxCount
SmallCheckMaxCount (Maybe Int -> Maybe SmallCheckMaxCount)
-> (TestName -> Maybe Int) -> TestName -> Maybe SmallCheckMaxCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Int
forall a. Read a => TestName -> Maybe a
safeRead
  optionName :: Tagged SmallCheckMaxCount TestName
optionName = TestName -> Tagged SmallCheckMaxCount TestName
forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"smallcheck-max-count"
  optionHelp :: Tagged SmallCheckMaxCount TestName
optionHelp = TestName -> Tagged SmallCheckMaxCount TestName
forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"Maximum smallcheck test count"
  optionCLParser :: Parser SmallCheckMaxCount
optionCLParser = Mod OptionFields SmallCheckMaxCount -> Parser SmallCheckMaxCount
forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (Mod OptionFields SmallCheckMaxCount -> Parser SmallCheckMaxCount)
-> Mod OptionFields SmallCheckMaxCount -> Parser SmallCheckMaxCount
forall a b. (a -> b) -> a -> b
$ TestName -> Mod OptionFields SmallCheckMaxCount
forall (f :: * -> *) a. HasMetavar f => TestName -> Mod f a
metavar TestName
"NUMBER"

instance IsTest (SC.Property IO) where
  testOptions :: Tagged (Property IO) [OptionDescription]
testOptions = [OptionDescription] -> Tagged (Property IO) [OptionDescription]
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ Proxy SmallCheckDepth -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy SmallCheckDepth
forall k (t :: k). Proxy t
Proxy :: Proxy SmallCheckDepth)
    , Proxy SmallCheckMaxCount -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy SmallCheckMaxCount
forall k (t :: k). Proxy t
Proxy :: Proxy SmallCheckMaxCount)
    ]

  run :: OptionSet -> Property IO -> (Progress -> IO ()) -> IO Result
run OptionSet
opts Property IO
prop Progress -> IO ()
yieldProgress = do
    let
      SmallCheckDepth Int
depth = OptionSet -> SmallCheckDepth
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      SmallCheckMaxCount Int
maxCount = OptionSet -> SmallCheckMaxCount
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts

    IORef (Int, Int)
counter <- (Int, Int) -> IO (IORef (Int, Int))
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int, Int
0 :: Int)

    let
      hook :: TestQuality -> IO ()
hook TestQuality
quality = do
        let
          inc :: (Int, Int) -> (Int, Int)
inc (Int
total, Int
bad) =
            case TestQuality
quality of
              TestQuality
GoodTest -> ((,) (Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$! Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bad
              TestQuality
BadTest -> ((,) (Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$! Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> (Int, Int)) -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$! Int
bad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        Int
count <- IORef (Int, Int) -> ((Int, Int) -> ((Int, Int), Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
myAtomicModifyIORef' IORef (Int, Int)
counter (\(Int, Int)
c -> let c' :: (Int, Int)
c' = (Int, Int) -> (Int, Int)
inc (Int, Int)
c in ((Int, Int)
c', (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
c'))

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxCount) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Finish -> IO ()
forall e a. Exception e => e -> IO a
throwIO Finish
Finish

        -- submit progress data to tasty
        Progress -> IO ()
yieldProgress (Progress -> IO ()) -> Progress -> IO ()
forall a b. (a -> b) -> a -> b
$ Progress :: TestName -> Float -> Progress
Progress
          { progressText :: TestName
progressText = Int -> TestName
forall a. Show a => a -> TestName
show Int
count
          , progressPercent :: Float
progressPercent = Float
0 -- we don't know the total number of tests
          }

    -- small check does not catch exceptions on its own, so lets do it
    Either SomeException (Maybe PropertyFailure)
scResult <- IO (Maybe PropertyFailure)
-> IO (Either SomeException (Maybe PropertyFailure))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe PropertyFailure)
 -> IO (Either SomeException (Maybe PropertyFailure)))
-> IO (Maybe PropertyFailure)
-> IO (Either SomeException (Maybe PropertyFailure))
forall a b. (a -> b) -> a -> b
$ Int
-> (TestQuality -> IO ())
-> Property IO
-> IO (Maybe PropertyFailure)
forall (m :: * -> *) a.
Testable m a =>
Int -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
smallCheckWithHook Int
depth TestQuality -> IO ()
hook Property IO
prop

    (Int
total, Int
bad) <- IORef (Int, Int) -> IO (Int, Int)
forall a. IORef a -> IO a
readIORef IORef (Int, Int)
counter
    let
      desc :: TestName
desc
        | Int
bad Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          = TestName -> Int -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%d tests completed" Int
total
        | Bool
otherwise
          = TestName -> Int -> Int -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%d tests completed (but %d did not meet the condition)" Int
total Int
bad

    Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$
      case Either SomeException (Maybe PropertyFailure)
scResult of
        Left SomeException
e
          | Just Finish
Finish <- SomeException -> Maybe Finish
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
                       -> TestName -> Result
testPassed TestName
desc
          | Bool
otherwise  -> TestName -> Result
testFailed (TestName -> Result) -> TestName -> Result
forall a b. (a -> b) -> a -> b
$ SomeException -> TestName
forall a. Show a => a -> TestName
show SomeException
e
        Right Maybe PropertyFailure
Nothing  -> TestName -> Result
testPassed TestName
desc
        Right (Just PropertyFailure
f) -> TestName -> Result
testFailed (TestName -> Result) -> TestName -> Result
forall a b. (a -> b) -> a -> b
$ PropertyFailure -> TestName
ppFailure PropertyFailure
f

data Finish = Finish
  deriving (Finish -> Finish -> Bool
(Finish -> Finish -> Bool)
-> (Finish -> Finish -> Bool) -> Eq Finish
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finish -> Finish -> Bool
$c/= :: Finish -> Finish -> Bool
== :: Finish -> Finish -> Bool
$c== :: Finish -> Finish -> Bool
Eq, Int -> Finish -> ShowS
[Finish] -> ShowS
Finish -> TestName
(Int -> Finish -> ShowS)
-> (Finish -> TestName) -> ([Finish] -> ShowS) -> Show Finish
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
showList :: [Finish] -> ShowS
$cshowList :: [Finish] -> ShowS
show :: Finish -> TestName
$cshow :: Finish -> TestName
showsPrec :: Int -> Finish -> ShowS
$cshowsPrec :: Int -> Finish -> ShowS
Show)

instance Exception Finish

-- Copied from base to stay compatible with GHC 7.4.
myAtomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
myAtomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b
myAtomicModifyIORef' IORef a
ref a -> (a, b)
f = do
    b
b <- IORef a -> (a -> (a, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
ref
            (\a
x -> let (a
a, b
b) = a -> (a, b)
f a
x
                    in (a
a, a
a a -> b -> b
`seq` b
b))
    b
b b -> IO b -> IO b
`seq` b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b