-------------------------------------------------------------------------
-- quickCheck

-- | Our SmartCheck reimplementation of the main QuickCheck driver.  We want to
-- distinguish the first argument to a 'Testable' property to be SmartChecked.
-- In particular: the first argument will not be shrunk (even if there are
-- default shrink instances for the type).  However, the argument will be grown
-- according to the the 'maxSize' argument to QuickCheck, in accordance with its
-- generator.  Other arguments will be shrunk, if they have shrinking instances.
scQuickCheckWithResult :: forall a prop. (Show a, Arbitrary a, Testable prop)
  => Args -> (a -> prop) -> IO (Maybe a, Result)
scQuickCheckWithResult a p = (if chatty a then withStdioTerminal else withNullTerminal) $ \tm -> do
     rnd <- case replay a of
              Nothing      -> newQCGen
              Just (rnd,_) -> return rnd
     test S.MkState{ S.terminal                  = tm
                   , S.maxSuccessTests           = maxSuccess a
                   , S.maxDiscardedTests         = maxDiscardRatio a * maxSuccess a
                   , S.computeSize               = case replay a of
                                                   Nothing    -> computeSize'
                                                   Just (_,s) -> computeSize' `at0` s
                   , S.numSuccessTests           = 0
                   , S.numDiscardedTests         = 0
                   , S.labels                    = M.empty
                   , S.numRecentlyDiscardedTests = 0
                   , S.collected                 = []
                   , S.expectedFailure           = False
                   , S.randomSeed                = rnd
                   , S.numSuccessShrinks         = 0
                   , S.numTryShrinks             = 0
                   , S.numTotTryShrinks          = 0
                   } flipProp
  where computeSize' 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 a + maxSize a <= maxSuccess a ||
            n >= maxSuccess a ||
            maxSuccess a `mod` maxSize a == 0 = (n `mod` maxSize a + d `div` 10) `min` maxSize a
          | otherwise =
            ((n `mod` maxSize a) * maxSize a `div` (maxSuccess a `mod` maxSize a) + d `div` 10) `min` maxSize a
        n `roundTo` m = (n `div` m) * m
        at0 _f s 0 0  = s
        at0 f _s n d  = f n d

        flipProp :: QCGen -> Int -> (a -> Prop)
        flipProp q i = \a' ->
          let p' = p a' in
          let g = unGen (unProperty (property p')) in
          g q i

--------------------------------------------------------------------------
-- main test loop

scQuickCheckWithResult :: forall a prop. (Show a, Arbitrary a, Testable prop)
  => Args -> (a -> prop) -> IO (Maybe a, Result)
scQuickCheckWithResult a p = (if chatty a then withStdioTerminal else withNullTerminal) $ \tm -> do
     rnd <- case replay a of
              Nothing      -> newQCGen
              Just (rnd,_) -> return rnd
     test S.MkState{ S.terminal                  = tm
                   , S.maxSuccessTests           = maxSuccess a
                   , S.maxDiscardedTests         = maxDiscardRatio a * maxSuccess a
                   , S.computeSize               = case replay a of
                                                   Nothing    -> computeSize'
                                                   Just (_,s) -> computeSize' `at0` s
                   , S.numSuccessTests           = 0
                   , S.numDiscardedTests         = 0
                   , S.labels                    = M.empty
                   , S.numRecentlyDiscardedTests = 0
                   , S.collected                 = []
                   , S.expectedFailure           = False
                   , S.randomSeed                = rnd
                   , S.numSuccessShrinks         = 0
                   , S.numTryShrinks             = 0
                   , S.numTotTryShrinks          = 0
                   } flipProp
  where computeSize' 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 a + maxSize a <= maxSuccess a ||
            n >= maxSuccess a ||
            maxSuccess a `mod` maxSize a == 0 = (n `mod` maxSize a + d `div` 10) `min` maxSize a
          | otherwise =
            ((n `mod` maxSize a) * maxSize a `div` (maxSuccess a `mod` maxSize a) + d `div` 10) `min` maxSize a
        n `roundTo` m = (n `div` m) * m
        at0 _f s 0 0  = s
        at0 f _s n d  = f n d

        flipProp :: QCGen -> Int -> (a -> Prop)
        flipProp q i = \a' ->
          let p' = p a' in
          let g = unGen (unProperty (property p')) in
          g q i

--------------------------------------------------------------------------
-- main test loop
scQuickCheckWithResult a p = (if chatty a then withStdioTerminal else withNullTerminal) $ \tm -> do
     rnd <- case replay a of
              Nothing      -> newQCGen
              Just (rnd,_) -> return rnd
     test S.MkState{ S.terminal                  = tm
                   , S.maxSuccessTests           = maxSuccess a
                   , S.maxDiscardedTests         = maxDiscardRatio a * maxSuccess a
                   , S.computeSize               = case replay a of
                                                   Nothing    -> computeSize'
                                                   Just (_,s) -> computeSize' `at0` s
                   , S.numSuccessTests           = 0
                   , S.numDiscardedTests         = 0
                   , S.labels                    = M.empty
                   , S.numRecentlyDiscardedTests = 0
                   , S.collected                 = []
                   , S.expectedFailure           = False
                   , S.randomSeed                = rnd
                   , S.numSuccessShrinks         = 0
                   , S.numTryShrinks             = 0
                   , S.numTotTryShrinks          = 0
                   } flipProp
  where computeSize' 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 a + maxSize a <= maxSuccess a ||
            n >= maxSuccess a ||
            maxSuccess a `mod` maxSize a == 0 = (n `mod` maxSize a + d `div` 10) `min` maxSize a
          | otherwise =
            ((n `mod` maxSize a) * maxSize a `div` (maxSuccess a `mod` maxSize a) + d `div` 10) `min` maxSize a
        n `roundTo` m = (n `div` m) * m
        at0 _f s 0 0  = s
        at0 f _s n d  = f n d

        flipProp :: QCGen -> Int -> (a -> Prop)
        flipProp q i = \a' ->
          let p' = p a' in
          let g = unGen (unProperty (property p')) in
          g q i

--------------------------------------------------------------------------
-- main test loop