darcs-benchmark (empty) → 0.1

raw patch · 9 files changed

+676/−0 lines, 9 filesdep +HTTPdep +basedep +bytestringbuild-type:Customsetup-changed

Dependencies added: HTTP, base, bytestring, containers, directory, filepath, html, mtl, network, process, regex-posix, tabular, tar, time, zlib

Files

• Benchmark.hs +198/−0
• Download.hs +34/−0
• LICENSE +26/−0
• README +39/−0
• Setup.hs +11/−0
• Shellish.hs +162/−0
• Standard.hs +87/−0
• darcs-benchmark.cabal +40/−0
• main.hs +79/−0

@@ -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 ]

@@ -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

@@ -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.

@@ -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.

@@ -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")+}

@@ -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)

@@ -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 ]+

@@ -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 <me@mornfall.net>+author:        Eric Kow <kowey@darcs.net>, Simon Michael <simon@joyful.com>+               and Petr Rockai <me@mornfall.net>+maintainer:    Petr Rockai <me@mornfall.net>+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

@@ -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