{-# LANGUAGE CPP #-}

module Test.Chell.QuickCheck
  ( property
  ) where

import           Data.Monoid (mempty)
import           System.Random (mkStdGen)

import qualified Test.Chell as Chell
import qualified Test.QuickCheck as QuickCheck
import qualified Test.QuickCheck.Gen as Gen
#if MIN_VERSION_QuickCheck(2,7,0)
import           Test.QuickCheck.Property (unProperty)
import qualified Test.QuickCheck.Random as QCRandom
#endif
import qualified Test.QuickCheck.State as State
import qualified Test.QuickCheck.Test as Test
import qualified Test.QuickCheck.Text as Text

-- | Convert a QuickCheck property to a Chell 'Chell.Test'.
--
-- @
--import Test.Chell
--import Test.Chell.QuickCheck
--import Test.QuickCheck hiding (property)
--
--test_NullLength :: Test
--test_NullLength = property \"null-length\"
--    (\xs -> not (null xs) ==> length xs > 0)
-- @
property :: QuickCheck.Testable prop => String -> prop -> Chell.Test
#if MIN_VERSION_QuickCheck(2,6,0)
property :: String -> prop -> Test
property String
name prop
prop = String -> (TestOptions -> IO TestResult) -> Test
Chell.test String
name ((TestOptions -> IO TestResult) -> Test)
-> (TestOptions -> IO TestResult) -> Test
forall a b. (a -> b) -> a -> b
$ \TestOptions
opts -> (Terminal -> IO TestResult) -> IO TestResult
forall a. (Terminal -> IO a) -> IO a
Text.withNullTerminal ((Terminal -> IO TestResult) -> IO TestResult)
-> (Terminal -> IO TestResult) -> IO TestResult
forall a b. (a -> b) -> a -> b
$ \Terminal
term ->
  do
#else
property name prop = Chell.test name $ \opts ->
  do
    term <- Text.newNullTerminal
#endif

    let
        seed :: Int
seed = TestOptions -> Int
Chell.testOptionSeed TestOptions
opts

        args :: Args
args = Args
QuickCheck.stdArgs

        state :: State
state = MkState :: Terminal
-> Int
-> Int
-> Maybe Confidence
-> (Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> Map (Maybe String, String) Double
-> Bool
-> QCGen
-> Int
-> Int
-> Int
-> State
State.MkState
            { terminal :: Terminal
State.terminal = Terminal
term
            , maxSuccessTests :: Int
State.maxSuccessTests = Args -> Int
QuickCheck.maxSuccess Args
args
#if MIN_VERSION_QuickCheck(2,10,1)
            , maxDiscardedRatio :: Int
State.maxDiscardedRatio = Args -> Int
QuickCheck.maxDiscardRatio Args
args
#else
            , State.maxDiscardedTests = maxDiscardedTests args prop
#endif

            , computeSize :: Int -> Int -> Int
State.computeSize = Int -> Int -> Int -> Int -> Int
computeSize (Args -> Int
QuickCheck.maxSize Args
args) (Args -> Int
QuickCheck.maxSuccess Args
args)
            , numSuccessTests :: Int
State.numSuccessTests = Int
0
            , numDiscardedTests :: Int
State.numDiscardedTests = Int
0
#if MIN_VERSION_QuickCheck(2,12,0)
            , classes :: Map String Int
State.classes = Map String Int
forall a. Monoid a => a
mempty
            , tables :: Map String (Map String Int)
State.tables = Map String (Map String Int)
forall a. Monoid a => a
mempty
            , requiredCoverage :: Map (Maybe String, String) Double
State.requiredCoverage = Map (Maybe String, String) Double
forall a. Monoid a => a
mempty
            , expected :: Bool
State.expected = Bool
True
            , coverageConfidence :: Maybe Confidence
State.coverageConfidence = Maybe Confidence
forall a. Maybe a
Nothing
#else
            , State.collected = []
            , State.expectedFailure = False
#endif

#if MIN_VERSION_QuickCheck(2,7,0)
            , randomSeed :: QCGen
State.randomSeed = Int -> QCGen
QCRandom.mkQCGen Int
seed
#else
            , State.randomSeed = mkStdGen seed
#endif
            , numSuccessShrinks :: Int
State.numSuccessShrinks = Int
0
            , numTryShrinks :: Int
State.numTryShrinks = Int
0
#if MIN_VERSION_QuickCheck(2,5,0)
            , numTotTryShrinks :: Int
State.numTotTryShrinks = Int
0
#endif
#if MIN_VERSION_QuickCheck(2,5,1)
            , numRecentlyDiscardedTests :: Int
State.numRecentlyDiscardedTests = Int
0
#endif
#if MIN_VERSION_QuickCheck(2,8,0)
            , labels :: Map [String] Int
State.labels = Map [String] Int
forall a. Monoid a => a
mempty
#endif
#if MIN_VERSION_QuickCheck(2,10,0)
            , numTotMaxShrinks :: Int
State.numTotMaxShrinks = Args -> Int
QuickCheck.maxShrinks Args
args
#endif
            }

#if MIN_VERSION_QuickCheck(2,12,0)
    Result
result <- State -> Property -> IO Result
Test.test State
state (prop -> Property
forall prop. Testable prop => prop -> Property
QuickCheck.property prop
prop)
#else
#if MIN_VERSION_QuickCheck(2,7,0)
    let
        genProp = unProperty (QuickCheck.property prop)
#else
    let
        genProp = QuickCheck.property prop
#endif
    result <- Test.test state (Gen.unGen genProp)
#endif
    let
        output :: String
output = Result -> String
Test.output Result
result
        notes :: [(String, String)]
notes = [(String
"seed", Int -> String
forall a. Show a => a -> String
show Int
seed)]
        failure :: Failure
failure = Failure
Chell.failure { failureMessage :: String
Chell.failureMessage = String
output }

    TestResult -> IO TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TestResult -> IO TestResult) -> TestResult -> IO TestResult
forall a b. (a -> b) -> a -> b
$
        case Result
result of
            Test.Success{} -> [(String, String)] -> TestResult
Chell.TestPassed [(String, String)]
notes
            Test.Failure{} -> [(String, String)] -> [Failure] -> TestResult
Chell.TestFailed [(String, String)]
notes [Failure
failure]
            Test.GaveUp{} -> [(String, String)] -> String -> TestResult
Chell.TestAborted [(String, String)]
notes String
output
            Test.NoExpectedFailure{} -> [(String, String)] -> [Failure] -> TestResult
Chell.TestFailed [(String, String)]
notes [Failure
failure]

-- copied from quickcheck-2.4.1.1/src/Test/QuickCheck/Test.hs
computeSize :: Int -> Int -> Int -> Int -> Int
computeSize :: Int -> Int -> Int -> Int -> Int
computeSize Int
maxSize Int
maxSuccess Int
n Int
d
    -- e.g. with maxSuccess = 250, maxSize = 100, goes like this:
    -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98.
    | Int
n Int -> Int -> Int
`roundTo` Int
maxSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxSuccess Bool -> Bool -> Bool
||
      Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxSuccess Bool -> Bool -> Bool
||
      Int
maxSuccess Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
maxSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
          Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
maxSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10
    | Bool
otherwise =
          (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
maxSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
maxSuccess Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
maxSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10

roundTo :: Int -> Int -> Int
roundTo :: Int -> Int -> Int
roundTo Int
n Int
m = (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m

maxDiscardedTests :: QuickCheck.Testable prop => QuickCheck.Args -> prop -> Int
#if MIN_VERSION_QuickCheck(2,9,0)
maxDiscardedTests :: Args -> prop -> Int
maxDiscardedTests Args
args prop
_ = Args -> Int
QuickCheck.maxDiscardRatio Args
args
#elif MIN_VERSION_QuickCheck(2,5,0)
maxDiscardedTests args p =
    if QuickCheck.exhaustive p
        then QuickCheck.maxDiscardRatio args
        else QuickCheck.maxDiscardRatio args * QuickCheck.maxSuccess args
#else
maxDiscardedTests args _ = QuickCheck.maxDiscard args
#endif