diff --git a/Benchmark.hs b/Benchmark.hs new file mode 100644 --- /dev/null +++ b/Benchmark.hs @@ -0,0 +1,198 @@ +module Benchmark where + +import Shellish hiding ( run ) +import Data.Char +import Data.List +import Data.Maybe +import System.Directory +import System.FilePath( (), (<.>) ) +import System.IO +import qualified Text.Tabular as Tab +import qualified Text.Tabular.AsciiArt as TA +import System.Exit +import Text.Printf +import Text.Regex.Posix( (=~) ) +import Data.Time.Clock +import Control.Monad.Error +import Control.Monad.State( liftIO ) +import Control.Exception( throw ) +import System.Process( runInteractiveProcess, runInteractiveCommand, + waitForProcess ) + +precision, iterations :: Int +precision = 1 +iterations = 2 +combine :: Ord a => [a] -> a +combine = minimum + +data MemTime = MemTime Rational Float +type Darcs = [String] -> Command String + +newtype TestRepo = TestRepo String deriving Eq +data TestBinary = TestBinary String + +type BenchmarkCmd a = Darcs -> Command a +data Benchmark a = Idempotent String (BenchmarkCmd a) + | Destructive String (BenchmarkCmd a) + +data Test a = Test (Benchmark a) TestRepo TestBinary + +copyTree :: FilePath -> FilePath -> IO () +copyTree from to = + do subs <- (\\ [".", ".."]) `fmap` getDirectoryContents from + createDirectory to + forM_ subs $ \item -> do + is_dir <- doesDirectoryExist (from item) + is_file <- doesFileExist (from item) + when is_dir $ copyTree (from item) (to item) + when is_file $ copyFile (from item) (to item) + +reset :: Command () +reset = do + resetMemoryUsed + resetTimeUsed + +description :: Benchmark a -> String +description (Idempotent d _) = d +description (Destructive d _) = d + +exec :: Benchmark a -> FilePath -> Command a +exec (Idempotent _ cmd) darcs_path = do + cd "_playground" + cmd (darcs darcs_path) +exec (Destructive _ cmd) darcs_path = do + cd "_playground" + let cleanup = cd ".." >> rm_rf "_playground" + res <- cmd (darcs darcs_path) `catchError` \e -> (cleanup >> throw e) + cleanup + return res + +defaultrepo :: FilePath -> FilePath +defaultrepo path = (path "_darcs" "prefs" "defaultrepo") + +prepare :: String -> Command () +prepare repo = do + echo_n "!" + rm_rf "_playground" + echo_n "." + liftIO $ createDirectory "_playground" + let playrepo = "_playground" "repo" + origrepo = "repo" <.> repo + isrepo <- liftIO $ doesDirectoryExist (origrepo "_darcs") + unless isrepo $ fail $ origrepo ++ ": Not a darcs repository!" + liftIO $ copyTree origrepo playrepo + echo_n "." + wd <- pwd + liftIO $ writeFile (defaultrepo playrepo) (wd origrepo) + +prepareIfDifferent :: String -> Command () +prepareIfDifferent repo = do + let playrepo = "_playground" "repo" + origrepo = "repo" <.> repo + exist <- test_e "_playground" + current' <- if exist then liftIO $ readFile (defaultrepo playrepo) else return "" + let current = reverse (dropWhile (=='\n') $ reverse current') + wd <- pwd + if (exist && current == wd origrepo) then echo_n "..." + else prepare repo + +run :: Test a -> Command (Maybe MemTime) +run (Test benchmark (TestRepo testrepo) (TestBinary bin)) = do + (Just `fmap` run') `catchError` \e -> + do echo $ " error: " ++ show e + return Nothing + where run' = do + echo_n $ bin ++ " " ++ description benchmark ++ " [" ++ testrepo ++ "]: " + exe <- which $ bin + darcs_path <- case exe of + Nothing -> canonize bin + Just p -> return p + times <- sequence [ + do echo_n $ show i + sub $ do prepareIfDifferent testrepo + timed (exec benchmark darcs_path) + | i <- [1 .. iterations] ] + let time = combine [ t | MemTime _ t <- times ] + mem = combine [ m | MemTime m _ <- times ] + spaces = 45 - (length bin + length (description benchmark) + length testrepo) + result = MemTime mem time + echo $ (replicate spaces ' ') ++ (concat $ intersperse ", " $ formatResult result) + return result + +formatNumber :: (PrintfArg a, Fractional a) => a -> String +formatNumber = printf $ "%."++(show precision)++"f" + +formatResult :: MemTime -> [String] +formatResult (MemTime mem time) = + [ formatNumber time ++ "s" + , formatNumber ((realToFrac (mem / (1024*1024))) :: Float) ++ "M" ] + +tabulateRepo :: String -> [(Test a, Maybe MemTime)] -> Tab.Table String String String +tabulateRepo repo results = Tab.Table rowhdrs colhdrs rows + where + rowhdrs = Tab.Group Tab.NoLine $ map Tab.Header rownames + colhdrs = Tab.Group Tab.SingleLine $ map colgrp colnames + colgrp x = Tab.Group Tab.NoLine [Tab.Header x, Tab.Header ""] + colnames = nub [ label | (Test _ _ (TestBinary label), _) <- interesting ] + rownames = nub [ description bench | (Test bench _ _, _) <- interesting ] + interesting = [ test | test@(Test _ (TestRepo r) _, _) <- results, r == repo ] + rows = [ concat [ fmt $ find (match row column) interesting | column <- colnames ] + | row <- rownames ] + match bench binary (Test bench' _ (TestBinary binary'), _) = + bench == description bench' && binary == binary' + fmt (Just (_, Just x)) = formatResult x + fmt _ = [ "-", "-" ] + +tabulate :: [(Test a, Maybe MemTime)] -> [(String, Tab.Table String String String)] +tabulate results = zip repos $ map (flip tabulateRepo results) repos + where repos = nub [ repo | (Test _ (TestRepo repo) _, _) <- results ] + +timed :: Command a -> Command MemTime +timed a = do + resetMemoryUsed + t1 <- liftIO $ getCurrentTime + a + t2 <- liftIO $ getCurrentTime + mem <- memoryUsed + resetMemoryUsed + return $ MemTime (fromIntegral mem) (realToFrac $ diffUTCTime t2 t1) + +check_darcs :: String -> IO () +check_darcs cmd = do + (_,outH,_,procH) <- runInteractiveCommand $ cmd ++ " --version" + out <- strictGetContents outH + waitForProcess procH + case out of + '2':'.':_ -> return () + _ -> fail $ cmd ++ ": Not darcs 2.x binary." + +darcs :: String -> [String] -> Command String +darcs cmd args' = do + (res, _, stats) <- liftIO $ do + let args = args' ++ ["+RTS", "-sdarcs-stats", "-RTS"] + (_,outH,errH,procH) <- runInteractiveProcess cmd args Nothing Nothing + res <- strictGetContents outH + errs <- strictGetContents errH + ex <- waitForProcess procH + stats <- readFile "darcs-stats" `catch` \_ -> return "" + case ex of + ExitSuccess -> return () + ExitFailure n -> fail $ "darcs failed with error code " + ++ show n ++ "\nsaying: " ++ errs + return (res, errs, stats) + let bytes = (stats =~ "([0-9, ]+) M[bB] total memory in use") :: String + mem = (read (filter (`elem` "0123456789") bytes) :: Int) + recordMemoryUsed $ mem * 1024 * 1024 + return res + +benchMany :: [TestRepo] -> [TestBinary] -> [Benchmark a] -> Command [(Test a, Maybe MemTime)] +benchMany repos bins benches = + sequence [ do let test = Test bench repo bin + memtime <- run test + return (test, memtime) + | repo <- repos, bin <- bins, bench <- benches ] + +renderMany :: [(Test a, Maybe MemTime)] -> Command () +renderMany t = sequence_ [ do echo $ "\n=== " ++ r ++ " ===\n" + echo_n $ TA.render id id id tab + | (r, tab) <- tabulate t ] diff --git a/Download.hs b/Download.hs new file mode 100644 --- /dev/null +++ b/Download.hs @@ -0,0 +1,34 @@ +module Download where + +import Network.URI +import Network.HTTP +import Network.HTTP.Base +import qualified Codec.Archive.Tar as Tar ( read, unpack ) +import System.FilePath +import System.Directory +import Codec.Compression.Zlib( decompress ) +import Control.Monad + +baseurl :: String +baseurl = "http://repos.mornfall.net/darcs/benchmark-repos/" + +download :: String -> IO () +download repo = do + let Just url = parseURI $ baseurl ++ repo ++ ".tgz" + putStrLn $ "downloading and extracting: " ++ show url + exist_dir <- doesDirectoryExist $ "repo" <.> repo + exist_file <- doesFileExist $ "repo" <.> repo + let go = do rsp' <- simpleHTTP (mkRequest GET url) + rsp <- case rsp' of + Left e -> fail (show e) + Right x -> return x + when (rspCode rsp /= (2, 0, 0)) $ + fail ("download failed: " ++ rspReason rsp) + createDirectory $ "repo" <.> repo + bits <- getResponseBody rsp' + let entries = Tar.read $ decompress bits + Tar.unpack ("repo" <.> repo) entries + + if (exist_dir || exist_file) + then putStrLn $ "repo" <.> repo ++ " already exists, skipping!" + else go diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) Eric Kow 2008. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,39 @@ +Darcs benchmarking bits +======================= + +Running +------- + +Say `cabal install` to build and install the darcs-benchmark binary. When you +have one, run it to obtain further instructions. (Hint: --get will download the +benchmark repositories.) + +Writing Benchmarks +------------------ + +Please take a look at Standard.hs: this is a module with a bunch of "standard +darcs benchmarks", currently get, annotate, check, repair and some other. It +should be fairly clear how to write your own from these examples. Timing is the +overall time spent in the benchmark, memory is the peak memory usage reported +by RTS, from darcs invocations only (this also means that the darcs executables +supplied need to accept +RTS ... options). + +Adding repositories +------------------- + +To add a new repository: + +- cd my-bench-repo && tar czf ../my-bench-repo.tgz . +- upload the result somewhere and tell mornfall (me-at-mornfall-dot-org) + +To test locally, just darcs get /path/to/your/repository repo.your-repo and run +darcs-benchmark. + +Obtaining Profiles +----------------- + +Not yet implemented, but shouldn't be too hard. Probably we need to: + +- detect whether the binaries are compiled with profiling enabled, +- pass in the right RTS flags to produce some profiling output, +- stash away this output after each darcs invocation, to a predictable place. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,11 @@ +import Distribution.Simple + ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.LocalBuildInfo( LocalBuildInfo(..) ) +import System( system, exitWith ) +import System.FilePath( () ) + +main :: IO () +main = defaultMainWithHooks simpleUserHooks { + runTests = \ _ _ _ lbi -> do + exitWith =<< system (buildDir lbi "darcs-benchmark" "darcs-benchmark") +} diff --git a/Shellish.hs b/Shellish.hs new file mode 100644 --- /dev/null +++ b/Shellish.hs @@ -0,0 +1,162 @@ +module Shellish( cd, pwd, run, (#), withCurrentDirectory, strictGetContents, + shellish, silently, verbosely, Command, sub, echo, echo_n, + which, canonize, resetMemoryUsed, recordMemoryUsed, + memoryUsed, rm_rf, whenM, test_e, test_f, test_d, + resetTimeUsed, timeUsed, mv, ls ) + where + +import Data.List +import System.IO +import System.Directory +import System.Exit +import Control.Monad.State +import Control.Monad.Error +import Data.Time.Clock( getCurrentTime, diffUTCTime, UTCTime(..) ) +import Control.Exception ( bracket, evaluate ) +import Control.Monad ( when ) +import qualified Data.ByteString.Char8 as B +import System.Process( runInteractiveProcess, waitForProcess ) + +-- TODO maxMem is sort of a layering violation here... but who cares. +data St = St { sCode :: Int, sStderr :: B.ByteString , sStdout :: B.ByteString, + sVerbose :: Bool, maxMem :: Int, startTime :: UTCTime } + +type Command a = StateT St IO a + +cd :: String -> Command () +cd = liftIO . setCurrentDirectory + +mv :: String -> String -> Command () +mv a b = liftIO $ renameFile a b + +ls :: String -> Command [String] +ls dir = liftIO $ (\\ [".", ".."]) `fmap` getDirectoryContents dir + +pwd :: Command String +pwd = liftIO $ getCurrentDirectory + +echo :: String -> Command () +echo = liftIO . putStrLn + +echo_n :: String -> Command () +echo_n = liftIO . (>> hFlush System.IO.stdout) . putStr + +which :: String -> Command (Maybe String) +which = liftIO . findExecutable + +canonize :: String -> Command String +canonize = liftIO . canonicalizePath + +whenM :: Monad m => m Bool -> m () -> m () +whenM c a = do res <- c + when res a + +test_e :: String -> Command Bool +test_e f = liftIO $ do + dir <- doesDirectoryExist f + file <- doesFileExist f + return $ file || dir + +test_f :: String -> Command Bool +test_f = liftIO . doesFileExist + +test_d :: String -> Command Bool +test_d = liftIO . doesDirectoryExist + +rm_rf :: String -> Command () +rm_rf f = whenM (test_e f) $ liftIO $ removeDirectoryRecursive f + +run :: String -> [String] -> Command String +run cmd args = do + (_,outH,errH,procH) <- liftIO $ runInteractiveProcess cmd args Nothing Nothing + st <- get + res <- liftIO $ B.hGetContents outH + errs <- liftIO $ B.hGetContents errH + ex <- liftIO $ waitForProcess procH + when (sVerbose st) $ do + liftIO $ B.putStr res + liftIO $ B.putStr errs + case ex of + ExitSuccess -> return () + ExitFailure n -> fail $ "command " ++ cmd ++ " " ++ show args + ++ " failed with exit code " ++ show n + put $ st { sCode = 0, sStderr = errs, sStdout = res } + return $ B.unpack res + +(#) :: String -> [String] -> Command String +cmd # args = run cmd args + +silently :: Command a -> Command a +silently a = do + x <- get + put $ x { sVerbose = False } + r <- a + put x + return r + +verbosely :: Command a -> Command a +verbosely a = do + x <- get + put $ x { sVerbose = True } + r <- a + put x + return r + +sub :: Command a -> Command a +sub a = do + -- TODO save environment as well? + dir <- liftIO $ getCurrentDirectory + r <- a `catchError` (\e -> (liftIO $ setCurrentDirectory dir) >> throwError e) + liftIO $ setCurrentDirectory dir + return r + +shellish :: MonadIO m => Command a -> m a +shellish a = do + dir <- liftIO $ getCurrentDirectory + time <- liftIO getCurrentTime + r <- liftIO $ evalStateT a $ empty time + liftIO $ setCurrentDirectory dir + return r + where empty t = St { sCode = 0, sStderr = B.empty, + sStdout = B.empty, sVerbose = True, + maxMem = 0, startTime = t } + +strictGetContents :: Handle -> IO String +strictGetContents h = + do res <- hGetContents h + evaluate (length res) + return res + +withCurrentDirectory :: FilePath -> IO a -> IO a +withCurrentDirectory name m = + bracket + (do cwd <- getCurrentDirectory + when (name /= "") (setCurrentDirectory name) + return cwd) + (\oldwd -> setCurrentDirectory oldwd `catch` (\_ -> return ())) + (const m) + +recordMemoryUsed :: Int -> Command () +recordMemoryUsed u = do + x <- get + put x { maxMem = maximum [maxMem x, u] } + +resetMemoryUsed :: Command () +resetMemoryUsed = do + x <- get + put x { maxMem = 0 } + +resetTimeUsed :: Command () +resetTimeUsed = do + x <- get + t <- liftIO getCurrentTime + put x { startTime = t } + +memoryUsed :: Command Int +memoryUsed = do x <- get + return $ maxMem x + +timeUsed :: Command Float +timeUsed = do x <- get + t <- liftIO getCurrentTime + return $ realToFrac $ diffUTCTime t (startTime x) diff --git a/Standard.hs b/Standard.hs new file mode 100644 --- /dev/null +++ b/Standard.hs @@ -0,0 +1,87 @@ +module Standard( standard, fast ) where +import System.FilePath +import Shellish +import Benchmark hiding ( darcs ) +import Control.Monad( forM, filterM, when ) +import Control.Monad.Trans( liftIO ) +import qualified Control.Monad.State as MS + +check :: BenchmarkCmd () +check darcs = do + cd "repo" + darcs [ "check", "--no-test" ] + return () + +repair :: BenchmarkCmd () +repair darcs = do + cd "repo" + darcs [ "repair" ] + return () + +annotate :: BenchmarkCmd () +annotate darcs = do + cd "repo" + whenM ((not . or) `fmap` mapM test_e files) $ fail "no files to annotate" + sequence [ whenM (test_e f) $ (darcs [ "annotate", f ] >> return ()) + | f <- files ] + return () + where files = [ "Setup.hs", "Setup.lhs" ] + +get :: Int -> [String] -> BenchmarkCmd () +get n param darcs = do + forM [1..n] $ \x -> darcs $ "get" : param ++ ["repo", "get" ++ show x] + return () + +pull :: Int -> BenchmarkCmd () +pull n darcs = do + cd "repo" + darcs [ "unpull", "--last", show n, "--all" ] + reset -- the benchmark starts here + darcs [ "pull", "--all" ] + return () + +-- Oh my eyes! Oh noes! Horrible! +darcs_wh :: [String] -> BenchmarkCmd () +darcs_wh param darcs = do + state <- MS.get + newstate <- liftIO $ catch (MS.execStateT (darcs $ "whatsnew" : param) state) + (\_ -> return state) + MS.put newstate + +wh :: Int -> BenchmarkCmd () +wh n darcs = do + cd "repo" + forM [1..n] $ \_ -> darcs_wh [] darcs + return () + +wh_mod :: Int -> BenchmarkCmd () +wh_mod n darcs = do + cd "repo" + files <- filterM test_f =<< ls "." + when (null files) $ fail "no files to modify in repo root!" + forM files $ \f -> mv f $ f <.> "__foo__" + forM [1..n] $ \_ -> darcs_wh [] darcs + forM files $ \f -> mv (f <.> "__foo__") f + return () + +wh_l :: Int -> BenchmarkCmd () +wh_l n darcs = do + cd "repo" + forM [1..n] $ \_ -> darcs_wh [ "--look-for-adds" ] darcs + return () + +fast :: [ Benchmark () ] +fast = [ Destructive "get (full)" $ get 1 [] + , Destructive "get (lazy, x10)" $ get 10 ["--lazy"] + , Idempotent "pull 100" $ pull 100 + , Idempotent "annotate" annotate + , Idempotent "wh x50" $ wh 50 + , Idempotent "wh mod x50" $ wh_mod 50 + , Idempotent "wh -l x20" $ wh_l 20 ] + +standard :: [ Benchmark () ] +standard = fast ++ + [ Idempotent "check" check + , Idempotent "repair" repair + , Idempotent "pull 1000" $ pull 1000 ] + diff --git a/darcs-benchmark.cabal b/darcs-benchmark.cabal new file mode 100644 --- /dev/null +++ b/darcs-benchmark.cabal @@ -0,0 +1,40 @@ +name: darcs-benchmark +version: 0.1 +synopsis: Comparative benchmark suite for darcs. + +description: A simple tool to compare performance of different Darcs 2.x + instances. The program can download a set of test repositories, + or you can provide your own. Run the program without parameters to + get help. + +license: BSD3 +license-file: LICENSE +copyright: 2009 Petr Rockai +author: Eric Kow , Simon Michael + and Petr Rockai +maintainer: Petr Rockai +homepage: http://wiki.darcs.net/Development/Benchmarks +category: Testing +build-type: Custom +cabal-version: >= 1.6 +extra-source-files: README + +executable darcs-benchmark + if impl(ghc >= 6.8) + ghc-options: -fwarn-tabs + ghc-options: -Wall + ghc-prof-options: -prof -auto-all + + build-depends: base < 5, process, mtl, tabular >= 0.2, time, + regex-posix, html, filepath, directory, + containers, bytestring, network, HTTP >= 4000, tar, zlib + + main-is: main.hs + other-modules: Shellish + Benchmark + Standard + Download + +source-repository head + type: darcs + location: http://repos.mornfall.net/darcs/benchmark diff --git a/main.hs b/main.hs new file mode 100644 --- /dev/null +++ b/main.hs @@ -0,0 +1,79 @@ +#!/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