#!/usr/bin/env runhaskell
import Shellish( shellish, rm_rf )
import Control.Arrow ( first, second )
import System.Console.CmdArgs
import System.Cmd ( system )
import System.Exit
import System.Directory
import System.IO
import Control.Monad
import Control.Monad.Trans
import Benchmark
import Config (Config(Get,Run,Dist,Report))
import Definitions
import qualified Config as C
import Report
import Run
import Standard
import Dist ( createTarball )
import Download
import Data.List
import Data.Version ( showVersion )
import Paths_darcs_benchmark
import Text.JSON
import Data.IORef
help :: String
help = unlines [ "darcs-benchmark " ++ showVersion version ++ ": run standard darcs benchmarks"
, ""
, "Please either specify the repositories and binaries to run on like this:"
, "$ darcs-benchmark run <binary> [binary] [/ [repository] [repository]]"
, ""
, "or alternatively, to run on all available repos:"
, "$ darcs-benchmark run <binary> [binary]"
, ""
, "You can also create a file called 'config' in the working directory."
, "Put two lines in it, one with list of binaries, one with list of repos:"
, ""
, "binary binary binary"
, "repo repo repo"
, ""
, "(again, if the second line is not there, we run on all available repos)"
, ""
, "Thank you for benchmarking darcs!" ]
known_repos :: [String]
known_repos = [ "tabular", "tahoe-lafs", "darcs", "ghc-hashed" ]
download_repos :: [String] -> IO ()
download_repos r = forM_ (if null r then known_repos else r) download
doVMFlush :: FilePath -> IO ()
doVMFlush path = do system "sudo sh -c 'echo 3 > /proc/sys/vm/drop_caches'"
system $ path ++ " --version > /dev/null"
return ()
config :: [TestRepo] -> C.Config -> IO ([(TestRepo,[Benchmark ()])], [String])
config allrepos cfg = do
case cfg of
Get {} -> do
download_repos (C.repos cfg)
exitWith ExitSuccess
Dist {} -> do
createTarball (C.repo cfg)
exitWith ExitSuccess
Report {} -> do
shellish printCumulativeReport
exitWith ExitSuccess
Run {} -> do
haveConf <- doesFileExist "config"
conf <- if haveConf then lines `fmap` readFile "config"
else return []
let confrepos = if length conf > 1 then (words $ conf !! 1) else []
confbins = if length conf > 0 then words $ conf !! 0 else []
(bins,repos) = second (drop 1) $ break (== "/") (C.extra cfg)
userepos = if null repos then confrepos else repos
usebins = if null bins then confbins else bins
usetests' = if C.fast cfg then filter (\b -> speed b == FastB) benchmarks else benchmarks
usetests = case C.only cfg of
[] -> usetests'
os -> filter (\b -> any (\o -> o `isInfixOf` show b) os) usetests'
let setParams p = p { pFlush = if C.cold cfg then Just doVMFlush else Nothing }
modifyIORef global (first setParams)
filterTests <- if C.converge cfg
then do pstampPath <- (paramStampPath . fst) `fmap` readIORef global
ts <- readTimingsForParams pstampPath
return $ \r bs -> case lookup (trCoreName r) (sufficientData ts) of
Nothing -> bs
Just xs -> filter (\b -> not (description b `elem` xs)) bs
else return (const id)
when (null usebins) $ do
hPutStrLn stderr "Please specify at least one darcs binary to benchmark"
exitWith (ExitFailure 1)
let finalrepos = if null userepos then allrepos
else filter (\r -> any (matchRepo r) userepos) allrepos
finalbins = usebins
return ( map (\r -> (r, filterTests r usetests)) finalrepos
, finalbins
)
where
dropPrefix p x = if p `isPrefixOf` x then drop (length p) x else x
matchRepo tr x = trName tr == x || dropPrefix "repo." (trPath tr) == x
testRepoFromDir :: String -> TestRepo
testRepoFromDir d = TestRepo n n d Nothing [toVariant DefaultVariant] []
where
n = drop (length "repo.") d
main :: IO ()
main = do
cfg <- cmdArgs help C.defaultConfig
allrepos <- do listing <- getDirectoryContents "."
configs <- mapM readC $
filter ((/='~') . last) $
filter ("config." `isPrefixOf`) listing
let other = [ testRepoFromDir d | d <- listing
, "repo." `isPrefixOf` d
, d `notElem` map trPath configs ]
return (configs ++ other)
(reposNtests, binaries') <- config allrepos cfg
let repos = map fst reposNtests
unless (null $ repos \\ allrepos) $ do
let name r = intercalate ", " $ map trName r
putStrLn $ "Missing repositories: " ++ name (repos \\ allrepos)
exitWith $ ExitFailure 2
binaries <- forM binaries' check_vcs
mapM_ appendBinary binaries
when (null repos) $ do
putStrLn $ "Oops, no repositories! Consider doing a darcs-benchmark get."
putStrLn $ "(Alternatively, check that you are in the right directory.)"
exitWith $ ExitFailure 3
shellish $ do rm_rf "_playground"
-- for setting up variants, we probably want the latest/greatest
-- version of darcs in case the variant involves some new feature
case reverse binaries of
[] -> return ()
(b:_) -> setupVariants repos b
res <- benchMany reposNtests binaries
if C.dump cfg
then liftIO $ print res
else renderMany res
where
readC f =
do mj <- (resultToEither . decode) `fmap` readFile f
case mj of
Left e -> fail $ "Could not read " ++ f ++ ": " ++ show e
Right j -> return $ j