module Test.Chell.QuickCheck (property) where

import Test.Chell qualified as Chell
import Test.QuickCheck qualified as QuickCheck
import Test.QuickCheck.Random qualified as QCRandom
import Test.QuickCheck.State qualified as State
import Test.QuickCheck.Test qualified as Test
import Test.QuickCheck.Text qualified 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
property :: forall prop. Testable prop => String -> prop -> Test
property String
name prop
prop = String -> (TestOptions -> IO TestResult) -> Test
Chell.test String
name forall a b. (a -> b) -> a -> b
$ \TestOptions
opts -> forall a. (Terminal -> IO a) -> IO a
Text.withNullTerminal forall a b. (a -> b) -> a -> b
$ \Terminal
term ->
  do
    let seed :: Int
seed = TestOptions -> Int
Chell.testOptionSeed TestOptions
opts

        args :: Args
args = Args
QuickCheck.stdArgs

        state :: State
state =
          State.MkState
            { terminal :: Terminal
State.terminal = Terminal
term,
              maxSuccessTests :: Int
State.maxSuccessTests = Args -> Int
QuickCheck.maxSuccess Args
args,
              maxDiscardedRatio :: Int
State.maxDiscardedRatio = Args -> Int
QuickCheck.maxDiscardRatio Args
args,
              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,
              classes :: Map String Int
State.classes = forall a. Monoid a => a
mempty,
              tables :: Map String (Map String Int)
State.tables = forall a. Monoid a => a
mempty,
              requiredCoverage :: Map (Maybe String, String) Double
State.requiredCoverage = forall a. Monoid a => a
mempty,
              expected :: Bool
State.expected = Bool
True,
              coverageConfidence :: Maybe Confidence
State.coverageConfidence = forall a. Maybe a
Nothing,
              randomSeed :: QCGen
State.randomSeed = Int -> QCGen
QCRandom.mkQCGen Int
seed,
              numSuccessShrinks :: Int
State.numSuccessShrinks = Int
0,
              numTryShrinks :: Int
State.numTryShrinks = Int
0,
              numTotTryShrinks :: Int
State.numTotTryShrinks = Int
0,
              numRecentlyDiscardedTests :: Int
State.numRecentlyDiscardedTests = Int
0,
              labels :: Map [String] Int
State.labels = forall a. Monoid a => a
mempty,
              numTotMaxShrinks :: Int
State.numTotMaxShrinks = Args -> Int
QuickCheck.maxShrinks Args
args
            }

    Result
result <- State -> Property -> IO Result
Test.test State
state (forall prop. Testable prop => prop -> Property
QuickCheck.property prop
prop)
    let output :: String
output = Result -> String
Test.output Result
result
        notes :: [(String, String)]
notes = [(String
"seed", forall a. Show a => a -> String
show Int
seed)]
        failure :: Failure
failure = Failure
Chell.failure {failureMessage :: String
Chell.failureMessage = String
output}

    forall (m :: * -> *) a. Monad m => a -> m a
return 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
      forall a. Num a => a -> a -> a
+ Int
maxSize
      forall a. Ord a => a -> a -> Bool
<= Int
maxSuccess
      Bool -> Bool -> Bool
|| Int
n
      forall a. Ord a => a -> a -> Bool
>= Int
maxSuccess
      Bool -> Bool -> Bool
|| Int
maxSuccess
      forall a. Integral a => a -> a -> a
`mod` Int
maxSize
      forall a. Eq a => a -> a -> Bool
== Int
0 =
      Int
n forall a. Integral a => a -> a -> a
`mod` Int
maxSize forall a. Num a => a -> a -> a
+ Int
d forall a. Integral a => a -> a -> a
`div` Int
10
  | Bool
otherwise =
      (Int
n forall a. Integral a => a -> a -> a
`mod` Int
maxSize) forall a. Num a => a -> a -> a
* Int
maxSize forall a. Integral a => a -> a -> a
`div` (Int
maxSuccess forall a. Integral a => a -> a -> a
`mod` Int
maxSize) forall a. Num a => a -> a -> a
+ Int
d 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 forall a. Integral a => a -> a -> a
`div` Int
m) forall a. Num a => a -> a -> a
* Int
m