darcs-benchmark-0.1.8.3: Run.hs

module Run where

import Control.Monad.Error

import Benchmark
import Definitions
import Report
import Shellish hiding ( run )
import Standard
import qualified TabularRST as TR

benchMany :: [TestRepo] -> [TestBinary] -> [Benchmark a] -> Command [(Test a, Maybe MemTimeOutput)]
benchMany repos bins benches = do
  binsVers <- liftIO $ forM bins $
    \bin@(TestBinary b) -> do v <- darcsVersion b
                              return (bin, v)
  fmap concat $ forM repos $ \r -> do
    res <- sequence
             [ do let test = Test bench repo bin
                  memtime <- run test
                  return (test, memtime)
               | (bin,ver) <- binsVers, repo <- repoAndVariants ver r, bench <- benches ]
    let tables = repoTables benchmarks res
    if length tables == 1 then
      echo_n $ TR.render id id id $ tabulateRepo formatTimeResult (head tables)
      else error "Not expecting more than one table for a repo and its variants"
    return res
 where
  repoAndVariants v r = map (r `tweakVia`) (appropriateVariants v (trVariants r))
  tweakVia tr v =
   case vId v of
     DefaultVariant -> tr
     _ -> tr { trPath = variantRepoName v (trPath tr)
             , trName = trName tr ++ " " ++ vShortName v
             }