unATest :: forall a. (Arbitrary a)
         => S.State
         -> (QCGen -> Int -> (a -> Prop))
         -> IO (Maybe a, Result)
runATest st f =
  do -- CALLBACK before_test
     putTemp (S.terminal st)
        ( "("
       ++ number (S.numSuccessTests st) "test"
       ++ concat [ "; " ++ show (S.numDiscardedTests st) ++ " discarded"
                 | S.numDiscardedTests st > 0
                 ]
       ++ ")"
        )
     let size = S.computeSize st (S.numSuccessTests st) (S.numRecentlyDiscardedTests st)

     let p :: a -> Prop
         p = f rnd1 size

     let genA :: QCGen -> Int -> a
         genA = unGen arbitrary
     let rndA = genA rnd1 size

     let mkRes res = return (Just rndA, res)

     MkRose res ts <- protectRose (reduceRose (unProp (p rndA)))
     callbackPostTest st res

     let continue break st' | abort res = break st'
                            | otherwise = test st'

     case res of
       MkResult{ok = Just True, stamp, expect} -> -- successful test
         do continue doneTesting
              st{ S.numSuccessTests           = S.numSuccessTests st + 1
                , S.numRecentlyDiscardedTests = 0
                , S.randomSeed                = rnd2
                , S.collected                 = stamp : S.collected st
                , S.expectedFailure           = expect
                } f

       MkResult{ok = Nothing, expect = expect} -> -- discarded test
         do continue giveUp
              st{ S.numDiscardedTests         = S.numDiscardedTests st + 1
                , S.numRecentlyDiscardedTests = S.numRecentlyDiscardedTests st + 1
                , S.randomSeed                = rnd2
                , S.expectedFailure           = expect
                } f

       MkResult{ok = Just False} -> -- failed test
         do if expect res
              then putPart (S.terminal st) (bold "*** Failed! ")
              else putPart (S.terminal st) "+++ OK, failed as expected. "
            (numShrinks, totFailed, lastFailed) <- foundFailure st res ts
            theOutput <- terminalOutput (S.terminal st)
            if not (expect res) then
              mkRes  Success{ labels   = summary st,
                              numTests = S.numSuccessTests st+1,
                              output   = theOutput
                            }
             else
              mkRes  Failure{ -- correct! (this will be split first)
                              usedSeed       = S.randomSeed st
                            , usedSize       = size
                            , numTests       = S.numSuccessTests st+1
                            , numShrinks     = numShrinks
                            , numShrinkTries = totFailed
                            , numShrinkFinal = lastFailed
                            , output         = theOutput
                            , reason         = P.reason res
                            , theException   = P.theException res
                            , labels         = summary st
                            }
 where
  (rnd1,rnd2) = split (S.randomSeed st)

runATest :: forall a. (Arbitrary a)
         => S.State
         -> (QCGen -> Int -> (a -> Prop))
         -> IO (Maybe a, Result)
runATest st f =
  do -- CALLBACK before_test
     putTemp (S.terminal st)
        ( "("
       ++ number (S.numSuccessTests st) "test"
       ++ concat [ "; " ++ show (S.numDiscardedTests st) ++ " discarded"
                 | S.numDiscardedTests st > 0
                 ]
       ++ ")"
        )
     let size = S.computeSize st (S.numSuccessTests st) (S.numRecentlyDiscardedTests st)

     let p :: a -> Prop
         p = f rnd1 size

     let genA :: QCGen -> Int -> a
         genA = unGen arbitrary
     let rndA = genA rnd1 size

     let mkRes res = return (Just rndA, res)

     MkRose res ts <- protectRose (reduceRose (unProp (p rndA)))
     callbackPostTest st res

     let continue break st' | abort res = break st'
                            | otherwise = test st'

     case res of
       MkResult{ok = Just True, stamp, expect} -> -- successful test
         do continue doneTesting
              st{ S.numSuccessTests           = S.numSuccessTests st + 1
                , S.numRecentlyDiscardedTests = 0
                , S.randomSeed                = rnd2
                , S.collected                 = stamp : S.collected st
                , S.expectedFailure           = expect
                } f

       MkResult{ok = Nothing, expect = expect} -> -- discarded test
         do continue giveUp
              st{ S.numDiscardedTests         = S.numDiscardedTests st + 1
                , S.numRecentlyDiscardedTests = S.numRecentlyDiscardedTests st + 1
                , S.randomSeed                = rnd2
                , S.expectedFailure           = expect
                } f

       MkResult{ok = Just False} -> -- failed test
         do if expect res
              then putPart (S.terminal st) (bold "*** Failed! ")
              else putPart (S.terminal st) "+++ OK, failed as expected. "
            (numShrinks, totFailed, lastFailed) <- foundFailure st res ts
            theOutput <- terminalOutput (S.terminal st)
            if not (expect res) then
              mkRes  Success{ labels   = summary st,
                              numTests = S.numSuccessTests st+1,
                              output   = theOutput
                            }
             else
              mkRes  Failure{ -- correct! (this will be split first)
                              usedSeed       = S.randomSeed st
                            , usedSize       = size
                            , numTests       = S.numSuccessTests st+1
                            , numShrinks     = numShrinks
                            , numShrinkTries = totFailed
                            , numShrinkFinal = lastFailed
                            , output         = theOutput
                            , reason         = P.reason res
                            , theException   = P.theException res
                            , labels         = summary st
                            }
 where
  (rnd1,rnd2) = split (S.randomSeed st)
runATest st f =
  do -- CALLBACK before_test
     putTemp (S.terminal st)
        ( "("
       ++ number (S.numSuccessTests st) "test"
       ++ concat [ "; " ++ show (S.numDiscardedTests st) ++ " discarded"
                 | S.numDiscardedTests st > 0
                 ]
       ++ ")"
        )
     let size = S.computeSize st (S.numSuccessTests st) (S.numRecentlyDiscardedTests st)

     let p :: a -> Prop
         p = f rnd1 size

     let genA :: QCGen -> Int -> a
         genA = unGen arbitrary
     let rndA = genA rnd1 size

     let mkRes res = return (Just rndA, res)

     MkRose res ts <- protectRose (reduceRose (unProp (p rndA)))
     callbackPostTest st res

     let continue break st' | abort res = break st'
                            | otherwise = test st'

     case res of
       MkResult{ok = Just True, stamp, expect} -> -- successful test
         do continue doneTesting
              st{ S.numSuccessTests           = S.numSuccessTests st + 1
                , S.numRecentlyDiscardedTests = 0
                , S.randomSeed                = rnd2
                , S.collected                 = stamp : S.collected st
                , S.expectedFailure           = expect
                } f

       MkResult{ok = Nothing, expect = expect} -> -- discarded test
         do continue giveUp
              st{ S.numDiscardedTests         = S.numDiscardedTests st + 1
                , S.numRecentlyDiscardedTests = S.numRecentlyDiscardedTests st + 1
                , S.randomSeed                = rnd2
                , S.expectedFailure           = expect
                } f

       MkResult{ok = Just False} -> -- failed test
         do if expect res
              then putPart (S.terminal st) (bold "*** Failed! ")
              else putPart (S.terminal st) "+++ OK, failed as expected. "
            (numShrinks, totFailed, lastFailed) <- foundFailure st res ts
            theOutput <- terminalOutput (S.terminal st)
            if not (expect res) then
              mkRes  Success{ labels   = summary st,
                              numTests = S.numSuccessTests st+1,
                              output   = theOutput
                            }
             else
              mkRes  Failure{ -- correct! (this will be split first)
                              usedSeed       = S.randomSeed st
                            , usedSize       = size
                            , numTests       = S.numSuccessTests st+1
                            , numShrinks     = numShrinks
                            , numShrinkTries = totFailed
                            , numShrinkFinal = lastFailed
                            , output         = theOutput
                            , reason         = P.reason res
                            , theException   = P.theException res
                            , labels         = summary st
                            }
 where
  (rnd1,rnd2) = split (S.randomSeed st)