include "Prelude"
include "Random"
include "Arbitrary"
include "IterN"

infixr 3  (==>)

data Counterexample = CounterexampleRoot | WithParameter String Counterexample
printCounterexample :: Counterexample -> <Proc> ()
printCounterexample CounterexampleRoot = ()
printCounterexample (WithParameter p ce) = do
    print $ "    " + p
    printCounterexample ce 

data TestResult = Success | Skipped | Failure Counterexample

injectParameter :: Show a => a -> TestResult -> TestResult
injectParameter p (Failure c) = Failure (WithParameter (show p) c)
injectParameter _ result = result

class Testable a where
    property :: a -> Gen TestResult

instance Testable (Gen TestResult) where
    property = id

instance Testable Boolean where
    property b = Gen $ \_ -> if b then Success else (Failure CounterexampleRoot)

instance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where
    property f = forAll arbitrary f

instance (Arbitrary a, Show a, Testable b) => Testable (a -> <Proc> b) where
    property f = forAll arbitrary (\x -> runProc (f x))

forAll :: Show a => Testable prop => Gen a -> (a -> prop) -> Gen TestResult
forAll gen f = Gen $ \n ->
    let parameter = runGen gen n
    in  injectParameter parameter (runGen (property (f parameter)) n)

(==>) :: Testable prop => Boolean -> prop -> Gen TestResult
cond ==> prop = Gen $ \n -> if cond then runGen (property prop) n else Skipped 

quickCheck :: Testable prop => prop -> <Proc> ()
quickCheck prop = runRandom (loop 0 0)
  where
    maxSuccesses = 100
    maxSkipped = 500
    maxCounterexampleSize = 25
    loop successCount skippedCount
      | successCount >= maxSuccesses = print "Test succeeded." 
      | skippedCount >= maxSkipped = print ("Test count exceeded. Did \(successCount)/\(maxSuccesses) successful test runs.")
      | otherwise = match runGen (property prop) (successCount + skippedCount `mod` maxCounterexampleSize) with
            Success -> loop skippedCount (successCount+1)
            Skipped -> loop (skippedCount+1) successCount
            Failure ce -> do
                print $ "Test failed after \(successCount) tries. Counterexample:"
                printCounterexample ce