{-# 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 name prop = Chell.test name $ \opts ->
        Text.withNullTerminal $ \term -> do
#else
property name prop = Chell.test name $ \opts -> do
        term <- Text.newNullTerminal
#endif

        let seed = Chell.testOptionSeed opts

        let args = QuickCheck.stdArgs
        let state = State.MkState
                { State.terminal = term
                , State.maxSuccessTests = QuickCheck.maxSuccess args
#if MIN_VERSION_QuickCheck(2,10,1)
                , State.maxDiscardedRatio = QuickCheck.maxDiscardRatio args
#else
                , State.maxDiscardedTests = maxDiscardedTests args prop
#endif

                , State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args)
                , State.numSuccessTests = 0
                , State.numDiscardedTests = 0
                , State.collected = []
                , State.expectedFailure = False

#if MIN_VERSION_QuickCheck(2,7,0)
                , State.randomSeed = QCRandom.mkQCGen seed
#else
                , State.randomSeed = mkStdGen seed
#endif
                , State.numSuccessShrinks = 0
                , State.numTryShrinks = 0
#if MIN_VERSION_QuickCheck(2,5,0)
                , State.numTotTryShrinks = 0
#endif
#if MIN_VERSION_QuickCheck(2,5,1)
                , State.numRecentlyDiscardedTests = 0
#endif
#if MIN_VERSION_QuickCheck(2,8,0)
                , State.labels = mempty
#endif
#if MIN_VERSION_QuickCheck(2,10,0)
                , State.numTotMaxShrinks = QuickCheck.maxShrinks args
#endif
		}
	
#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)
        let output = Test.output result
        let notes = [("seed", show seed)]
        let failure = Chell.failure { Chell.failureMessage = output }
        return $ case result of
                Test.Success{} -> Chell.TestPassed notes
                Test.Failure{} -> Chell.TestFailed notes [failure]
                Test.GaveUp{} -> Chell.TestAborted notes output
                Test.NoExpectedFailure{} -> Chell.TestFailed notes [failure]

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

roundTo :: Int -> Int -> Int
roundTo n m = (n `div` m) * m

maxDiscardedTests :: QuickCheck.Testable prop => QuickCheck.Args -> prop -> Int
#if MIN_VERSION_QuickCheck(2,9,0)
maxDiscardedTests args _ = QuickCheck.maxDiscardRatio 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