import Data.List
import Text.Printf
import System.IO
import System.Random
import Test.QuickCheck

prop0 = (sort [3,2,1], [1,3,2])

main = mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
 where
   n = 100
   tests = [("sort unit test", mytest prop0)]




------------------------------------------------------------------------
-- And a custom driver that `diff's the output

mytest :: (Show a, Eq a) => (a,a) -> Int -> IO ()
mytest (a,b) n = mycheck defaultConfig
    { configMaxTest=n
    , configEvery= \n args -> [] } a b

mycheck :: (Show a , Eq a) => Config -> a -> a -> IO ()
mycheck config a b =
  do rnd <- newStdGen
     mytests config (evaluate (a == b)) a b rnd 0 0 []

mytests :: (Show a , Eq a)
        => Config -> Gen Result -> a -> a -> StdGen -> Int -> Int -> [[String]] -> IO ()
mytests config gen a b rnd0 ntest nfail stamps
  | ntest == configMaxTest config = do done "OK," ntest stamps
  | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
  | otherwise               =
      do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
         case ok result of
           Nothing    ->
             mytests config gen a b rnd1 ntest (nfail+1) stamps
           Just True  ->
             mytests config gen a b rnd1 (ntest+1) nfail (stamp result:stamps)
           Just False ->
             putStr ( "Falsifiable after "
                   ++ show ntest
                   ++ " tests:\n"
                   ++ "- " ++ show a
                   ++ "\n"
                   ++ "+ " ++ show b
                   ++ "\n"
                    ) >> hFlush stdout
     where
      result      = generate (configSize config ntest) rnd2 gen
      (rnd1,rnd2) = split rnd0

done :: String -> Int -> [[String]] -> IO ()
done mesg ntest stamps =
  do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
 where
  table = display
        . map entry
        . reverse
        . sort
        . map pairLength
        . group
        . sort
        . filter (not . null)
        $ stamps

  display []  = ".\n"
  display [x] = " (" ++ x ++ ").\n"
  display xs  = ".\n" ++ unlines (map (++ ".") xs)

  pairLength xss@(xs:_) = (length xss, xs)
  entry (n, xs)         = percentage n ntest
                       ++ " "
                       ++ concat (intersperse ", " xs)

  percentage n m        = show ((100 * n) `div` m) ++ "%"