darcs-benchmark-0.1: main.hs

#!/usr/bin/env runhaskell
import Shellish( shellish, rm_rf )
import System.Exit
import System.Environment
import System.Directory
import Control.Monad
import Benchmark
import Standard
import Download
import Data.List

help :: String
help = unlines [ "darcs-benchmark: run standard darcs benchmarks"
               , ""
               , "Please either specify the repositories and binaries to run on like this:"
               , "$ darcs-benchmark binary binary -- repository repository"
               , ""
               , "or alternatively, to run on all available repos:"
               , "$ darcs-benchmark 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)"
               , ""
               , "NOTE: To obtain test repositories, you can use 'darcs-benchmark --get',"
               , "optionally supplying the names of the test repos you are interested in."
               , ""
               , "Thank you for benchmarking darcs!" ]

known_repos :: [String]
known_repos = [ "ghc-hashed", "darcs" ]

nonopt :: [String] -> [String]
nonopt args = [ r | r <- args, not $ "--" `isPrefixOf` r ]

download_repos :: [String] -> IO ()
download_repos r = do forM_ (if null r then known_repos else r) $ download
                      exitWith ExitSuccess

config :: [TestRepo] -> [String] -> IO ([TestRepo], [TestBinary], [Benchmark ()])
config allrepos args = do
  when ("--get" `elem` args) $ do download_repos (nonopt args)
  haveConf <- doesFileExist "config"
  when (not haveConf && null args) $ do
               putStrLn help
               exitWith $ ExitFailure 1
  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 = nonopt $ takeWhile (/= "--") args
      repos = nonopt $ dropWhile (/= "--") args
      userepos = map TestRepo $ if null repos then confrepos else repos
      usebins = map TestBinary $ if null bins then confbins else bins
      usetests = if "--fast" `elem` args then fast else standard
  return (if null userepos then allrepos else userepos, usebins, usetests)

main :: IO ()
main = do
    allrepos <- do listing <- getDirectoryContents "."
                   return $ [ TestRepo $ drop 5 repo
                              | repo <- listing, repo `notElem` [".", ".."]
                                               , "repo." `isPrefixOf` repo ]
    (repos, binaries, tests) <- config allrepos =<< getArgs
    unless (null $ repos \\ allrepos) $ do
         let name r = intercalate ", " $ map (\(TestRepo x) -> x) 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 --get."
         putStrLn $ "(Alternatively, check that you are in the right directory.)"
         exitWith $ ExitFailure 3
    shellish $ do rm_rf "_playground"
                  benchMany repos binaries tests >>= renderMany