darcs-benchmark-0.1.5.1: Standard.hs

module Standard( standard, fast ) where
import System.FilePath
import Shellish
import Benchmark hiding ( darcs )
import Control.Monad( forM_, mapM_, 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 :: 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"
  rm_f "_darcs/patches/unrevert"
  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 tr = do
  cd "repo"
  forM [1..n] $ \_ -> darcs_wh [] darcs tr
  return ()

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

wh_l :: Int -> BenchmarkCmd ()
wh_l n darcs tr = do
  cd "repo"
  forM [1..n] $ \_ -> darcs_wh [ "--look-for-adds" ] darcs tr
  return ()

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

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

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

fast :: [ Benchmark () ]
fast = [ Destructive "get (full)" $ get 1 []
       , Destructive "get (lazy, x10)" $ get 10 ["--lazy"]
       , Idempotent "pull 100" $ pull 100
       , Idempotent "wh x50" $ wh 50
       , Idempotent "wh mod x50" $ wh_mod 50
       , Idempotent "wh -l x20" $ wh_l 20
       , Idempotent "record mod x10" $ record_mod 10
       , Idempotent "revert mod x50" $ revert_mod 50
       , Idempotent "(un)revert mod x10" $ revert_unrevert 10
       ]

standard :: [ Benchmark () ]
standard = fast ++
           [ Idempotent "check" check
           , Idempotent "repair" repair
           , Idempotent "annotate" annotate
           , Idempotent "pull 1000" $ pull 1000 ]