#!/usr/bin/env runhaskell
{- 
bench.hs (see usage string below)

This is good for simple benchmark testing but not as flexible as shell
scripts; it can only run individual darcs commands. Example:

$ cat - >bench.tests
changes
changes -s
$ bench.hs .tests 2 ~/src/darcs darcs2.0 darcs2.1 darcs
Running 2 tests 2 times in /Users/simon/src/darcs with 3 executables:
1: darcs2.0 changes --repodir /Users/simon/src/darcs	[1.0s]
2: darcs2.0 changes --repodir /Users/simon/src/darcs	[1.0s]
1: darcs2.1 changes --repodir /Users/simon/src/darcs	[1.0s]
2: darcs2.1 changes --repodir /Users/simon/src/darcs	[0.9s]
1: darcs changes --repodir /Users/simon/src/darcs	[1.0s]
2: darcs changes --repodir /Users/simon/src/darcs	[0.9s]
1: darcs2.0 changes -s --repodir /Users/simon/src/darcs	[89.7s]
2: darcs2.0 changes -s --repodir /Users/simon/src/darcs	[5.8s]
1: darcs2.1 changes -s --repodir /Users/simon/src/darcs	[4.7s]
2: darcs2.1 changes -s --repodir /Users/simon/src/darcs	[4.7s]
1: darcs changes -s --repodir /Users/simon/src/darcs	[4.7s]
2: darcs changes -s --repodir /Users/simon/src/darcs	[4.7s]

Summary (best iteration):

           || darcs2.0 | darcs2.1 | darcs
===========++==========+==========+======
   changes ||      1.0 |      0.9 |   0.9
changes -s ||      5.8 |      4.7 |   4.7

-}

import Data.Char
import Data.List
import Data.Maybe
import Numeric
import System.Environment
import System.Directory
import System.FilePath
import System.Cmd
import System.IO
import Text.Tabular
import qualified Text.Tabular.AsciiArt as TA
import qualified Text.Tabular.Html     as TH
import Text.Html ((+++), renderHtml)
import System.Exit
import Text.Printf
import Data.Time.Clock
import Control.Monad

usage = "bench.hs <testsfile> <num> <repodir> [<darcsexecutable> ...]\n" ++
        "\n" ++
        "Run some functional tests, defined as lines of darcs arguments in\n" ++
        "testsfile, num times in repodir with each of the specified darcs\n" ++
        "executables (or just \"darcs\"), printing the execution times and a summary.\n" ++
        "Tips:\n" ++
        "- you can override repodir by using --repodir in tests.\n" ++
        "- comment out tests with #\n"

precision = 1

main = do
  (testsfile,iterations,repodir,exes) <- getArgs >>= return . parseargs
  tests <- liftM (filter (not . ("#" `isPrefixOf`)) . lines) $ readFile testsfile
  putStrLn $ printf "Running %d tests %d times in %s with %d executables:" 
               (length tests) (iterations) repodir (length exes)
  let doexe t e = sequence $ map (doiteration t e repodir) [1..iterations]
  let dotest t = sequence $ map (doexe t) exes
  hSetBuffering stdout NoBuffering
  results <- mapM dotest tests
  summarise tests exes results 
    where 
      parseargs (t:n:r:[]) = parseargs (t:n:r:["darcs"])
      parseargs (t:n:r:es) = (t,read n,r,es)
      parseargs _ = error $ "\n" ++ usage

doiteration :: String -> String -> String -> Int -> IO Float
doiteration test exe dir iteration = do
  let cmd = unwords [exe,test,"--repodir",dir]
  putStr $ show iteration ++ ": " ++ cmd
  hFlush stdout
  t <- time cmd
  printf "\t[%ss]\n" (showtime t)
  return t

time :: String -> IO Float
time cmd = do
  t1 <- getCurrentTime
  ret <- system $ cmd ++ ">/dev/null 2>&1"
  case ret of
    ExitSuccess -> return ()
    ExitFailure f -> putStr $ printf " (error %d)" f
  t2 <- getCurrentTime
  return $ realToFrac $ diffUTCTime t2 t1

summarise tests exes results = do
  -- putStrLn ""; print results
  putStrLn "\nSummary (best iteration):\n"
  let t = maketable tests exes results
  putStrLn $ TA.render id t
  -- putStrLn $ "See " ++ prefix ++ "summary.*"
  let outname = "summary"
  writeFile (outname <.> "txt") $ TA.render id t
  writeFile (outname <.> "html") $ renderHtml $ TH.css TH.defaultCss +++ TH.render id t

maketable :: [String] -> [String] -> [[[Float]]] -> Table String
maketable rownames colnames results = Table rowhdrs colhdrs rows
 where
  rowhdrs = Group NoLine $ map Header rownames
  colhdrs = Group SingleLine $ map Header colnames
  rows = map (map (showtime . minimum)) results

showtime = printf $ "%."++(show precision)++"f"