#!/usr/bin/env runhaskell
import Shellish( shellish, rm_rf )
import Control.Arrow ( 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))
import qualified Config as C
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], [TestBinary], [Benchmark ()])
config allrepos cfg = do
case cfg of
Get {} -> do
download_repos (C.repos cfg)
exitWith ExitSuccess
Dist {} -> do
createTarball (C.repo cfg)
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 = map TestBinary $ if null bins then confbins else bins
usetests' = if C.fast cfg then fast else standard
usetests = case C.only cfg of
[] -> usetests'
os -> filter (\b -> any (\o -> o `isInfixOf` show b) os) usetests'
when (C.cold cfg) $ writeIORef maybeVMFlush doVMFlush
when (null usebins) $ do
hPutStrLn stderr "Please specify at least one darcs binary to benchmark"
exitWith (ExitFailure 1)
return ( if null userepos then allrepos
else filter (\r -> any (matchRepo r) userepos) allrepos
, usebins
, usetests
)
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 ("config." `isPrefixOf`) listing
let other = [ testRepoFromDir d | d <- listing
, "repo." `isPrefixOf` d
, d `notElem` map trPath configs ]
return (configs ++ other)
(repos, binaries, tests) <- config allrepos cfg
unless (null $ repos \\ allrepos) $ do
let name r = intercalate ", " $ map trName r
putStrLn $ "Missing repositories: " ++ name (repos \\ allrepos)
exitWith $ ExitFailure 2
forM binaries $ \(TestBinary bin) -> check_darcs bin
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 repos binaries tests
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