darcs-benchmark-0.1.9: source/Standard.hs

module Standard( benchmarks ) where
import Prelude hiding ( catch )
import Control.Exception
import System.FilePath
import Shellish
import Benchmark hiding ( darcs )
import Definitions
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 tr = 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 = maybe id (:) (trAnnotate tr) [ "Setup.hs", "Setup.lhs" ]

get :: [String] -> BenchmarkCmd ()
get param darcs _ = do
  darcs $ "get" : param ++ ["repo", "get"]
  return ()

pull :: Int -> BenchmarkCmd ()
pull n darcs _ = do
  cd "repo"
  rm_f "_darcs/patches/unrevert"
  darcs [ "obliterate", "--last", show n, "--all" ]
  reset -- the benchmark starts here
  darcs [ "pull", "--all" ]
  return ()

darcs_wh :: [String] -> BenchmarkCmd ()
darcs_wh param darcs _ = (darcs ("whatsnew" : param) >> return ()) `catch_sh` handle
  where handle (RunFailed _ 1 _) = return ()
        handle e = throw e

wh :: BenchmarkCmd ()
wh darcs tr = do
  cd "repo"
  darcs_wh [] darcs tr
  return ()

wh_mod :: BenchmarkCmd ()
wh_mod darcs tr = 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__"
  darcs_wh [] darcs tr
  forM_ files $ \f -> mv (f <.> "__foo__") f
  return ()

wh_l :: BenchmarkCmd ()
wh_l darcs tr = do
  cd "repo"
  darcs_wh [ "--look-for-adds" ] darcs tr
  return ()

-- | n patches for each file
record :: BenchmarkCmd ()
record darcs _ = do
 cd "repo"
 files <- filterM test_f =<< ls "."
 forM_ files $ \f -> liftIO (appendFile f "x")
 darcs [ "record", "--author", "bench <bench@example.com>", "--all", "-m", "test record", "--no-test"]
 darcs [ "obliterate", "--last", "1", "--all" ]
 return ()

revert :: BenchmarkCmd ()
revert darcs _ = do
 cd "repo"
 files <- filterM test_f =<< ls "."
 forM_ files $ \f -> liftIO (appendFile f "foo")
 darcs [ "revert", "--all" ]
 return ()

revert_unrevert :: BenchmarkCmd ()
revert_unrevert darcs _ = do
 cd "repo"
 files <- filterM test_f =<< ls "."
 forM_ files $ \f -> liftIO (appendFile f (show "foo"))
 darcs [ "revert", "--all" ]
 darcs [ "unrevert", "--all" ]
 darcs [ "revert", "--all" ]
 return ()

benchmarks :: [ Benchmark () ]
benchmarks =
       [ Idempotent "wh" FastB wh
       , Idempotent "wh mod" FastB wh_mod
       , Idempotent "wh -l" FastB wh_l
       , Idempotent "record" FastB $ record
       , Idempotent "revert" FastB revert
       , Idempotent "(un)revert" FastB revert_unrevert
       , Destructive "get (full)" SlowB $ get []
       , Destructive "get (lazy)" FastB $ get ["--lazy"]
       , Idempotent "pull 100"    FastB $ pull 100
       , Idempotent "pull 1000" SlowB $ pull 1000
       , Idempotent "check" SlowB check
       , Idempotent "repair" SlowB repair
       , Idempotent "annotate" SlowB annotate
       ]