darcs-benchmark-0.1.9: source/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, [Benchmark a])] -> [TestBinary] -> Command [(Test a, Maybe MemTimeOutput)]
benchMany reposbenches bins = do
  fmap concat $ forM reposbenches $ \(r,benches) -> do
    res <- sequence
             [ do let test = Test bench repo bin
                  memtime <- run test
                  return (test, memtime)
               | bin <- bins
               , repo <- repoAndVariants bin r
               , bench <- filter (noSkip r) benches ]
    case repoTables benchmarks res of
     []  -> echo $ "No benchmarks to run for " ++ trCoreName r
     [t] -> echo_n $ TR.render id id id $ tabulateRepo formatTimeResult t
     _   -> error "Not expecting more than one table for a repo and its variants"
    return res
 where
  noSkip r b = not (description b `elem` trSkip r)
  repoAndVariants bin r = map (r `tweakVia`) (appropriateVariants bin (trVariants r))
  tweakVia tr v =
   case vId v of
     DefaultVariant -> tr
     _ -> tr { trPath = variantRepoName v (trPath tr)
             , trName = trName tr ++ " " ++ vShortName v
             }