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 ]