maybench 0.1 → 0.2
raw patch · 4 files changed
+26/−42 lines, 4 filesdep +benchpress
Dependencies added: benchpress
Files
- Test/Maybench.hs +14/−36
- darcs-benchmark/DarcsBenchmark.hs +5/−1
- maybench.cabal +4/−1
- wrapper/Maybench.hs +3/−4
Test/Maybench.hs view
@@ -3,13 +3,14 @@ import System.Time import System.Cmd (system) -- ideally this should use System.Process in the future, but for the sake of a first version this will do. import Data.Maybe (maybe, isJust, fromJust)-import Control.Monad (when,replicateM)+import Control.Monad (when) import Control.Monad.State (MonadIO, liftIO) import System.Directory (findExecutable) import System.IO (putStr,hPutStr,hClose,hGetContents) import System.Process (waitForProcess, runInteractiveProcess) import Test.Maybench.Command (CommandModifier, Command(Cmd), modifyCmd)+import Test.BenchPress ( benchmark, mean ) data Benchmark = Benchmark {benchIters :: Int, benchTimes :: [TimeDiff]} @@ -41,35 +42,14 @@ waitForProcess ph -- should check exit code here... return (output, err) -bench :: Maybe (IO a) -- ^ setup- -> IO b -- ^ action- -> Maybe (IO c) -- ^ cleanup- -> Int -- ^ iterations- -> IO Benchmark-bench setup action cleanup reps = do times <- replicateM reps core- return $ Benchmark reps times- where core = do maybe (return ()) (>> return ()) setup- start <- getClockTime- action- end <- getClockTime- maybe (return ()) (>> return ()) cleanup- return $ end `diffClockTimes` start+averageTime :: String -> String -> String -> Int -> IO Double+averageTime cmd setup cleanup n = do+ stats <- benchmark n (system setup)+ (const $ system cleanup)+ (const $ system cmd)+ return $ mean stats -benchSimple :: IO a -> Int -> IO Benchmark-benchSimple f = bench Nothing f Nothing -timeProgram :: String -> String -> String -> IO (String, TimeDiff)-timeProgram cmd setup cleanup = do time <- bench (Just $ system setup) (system cmd) (Just $ system cleanup) 1- return $ (cmd,averageTimeDiffs $ benchTimes time)--averageTimeDiffs :: [TimeDiff] -> TimeDiff-averageTimeDiffs = secondsToTimeDiff . mean . map timeDiffToSeconds- where mean xs = sum xs `div` length xs--averageTime :: String -> String -> String -> Int -> IO (String, TimeDiff)-averageTime cmd setup cleanup n = do times <- replicateM n (timeProgram cmd setup cleanup)- return (cmd,averageTimeDiffs (map snd times))- showTimeDiff :: (String, TimeDiff) -> String showTimeDiff (cmd,td) = case filter isJust [helper tdYear "years", helper tdMonth "months",@@ -101,11 +81,9 @@ secondsToTimeDiff :: Int -> TimeDiff secondsToTimeDiff sec = normalizeTimeDiff $ TimeDiff 0 0 0 0 0 sec 0 -compareTimes :: (String, TimeDiff) -> (String, TimeDiff) -> Maybe String-compareTimes (cmd1,td1) (cmd2,td2) = case (td1,td2) of- (TimeDiff 0 0 0 0 0 0 _,- TimeDiff 0 0 0 0 0 0 _) -> Nothing- _ -> Just $ show cmd2 ++ " took " ++- (show ((fromIntegral $ timeDiffToSeconds td2) `percentage` (fromIntegral $ timeDiffToSeconds td1) :: Double))- ++ "% of the time " ++ show cmd1 ++ " took."- where percentage x y = (fromIntegral $ (truncate $ (x / y * 10000 :: Double) :: Int)) / 100+compareTimes :: Fractional a => (String, a) -> (String, a) -> Maybe String+compareTimes (cmd1,t1) (cmd2,t2) =+ Just $ show cmd2 ++ " took " ++ show (t1 `percentage` t2)+ ++ "% of the time " ++ show cmd1 ++ " took."+ where percentage x y = (100 * x / y)+
darcs-benchmark/DarcsBenchmark.hs view
@@ -320,10 +320,14 @@ -- let is_darcs_flag (DarcsFlag _) = True is_darcs_flag _ = False+ cwd <- getCurrentDirectory+ let mkAbsolute ('.':'/':xs) = cwd ++ "/" ++ xs+ mkAbsolute p = p let initBenchConf = BenchConf { benchUrlRepo = undefined , benchCounts = undefined , interactive = InteractiveFlag `elem` opts- , darcsExecutable = fromMaybe "darcs" $ darcsFlag <$> find is_darcs_flag opts+ , darcsExecutable = fromMaybe "darcs" $+ (mkAbsolute . darcsFlag) <$> find is_darcs_flag opts } mUrl = listToMaybe [ f | RepoFlag f <- opts ] --
maybench.cabal view
@@ -1,5 +1,5 @@ Name: maybench-Version: 0.1+Version: 0.2 License: BSD3 License-file: LICENSE Author: Maybench developers@@ -27,6 +27,7 @@ Flag splitBase Description: Choose the new smaller, split-up base package. Library+ build-depends: benchpress >= 0.2.1 && < 0.3 if flag(splitBase) build-depends: base >= 3, process, old-time else@@ -38,6 +39,7 @@ Executable maybench Hs-Source-Dirs: ., wrapper+ build-depends: benchpress >= 0.2.1 && < 0.3 if flag(splitBase) build-depends: base >= 3, process@@ -48,6 +50,7 @@ Executable darcs-benchmark Hs-Source-Dirs: ., darcs-benchmark+ build-depends: benchpress >= 0.2.1 && < 0.3 if flag(splitBase) build-depends: base >= 3, process, unix, directory, time, mtl, filepath
wrapper/Maybench.hs view
@@ -32,9 +32,8 @@ lookupOpt opt = lookup opt . fst3 $ opts setup i = fromMaybe "true" (lookupOpt ("setup" ++ show i)) cleanup i = fromMaybe "true" (lookupOpt ("cleanup" ++ show i))- test n c = case lookupOpt "repetitions" of- Nothing -> timeProgram c (setup n) (cleanup n)- Just r -> averageTime c (setup n) (cleanup n) (read r)+ iters = maybe 1 read $ lookupOpt "repetitions"+ test n c = averageTime c (setup n) (cleanup n) iters case opts of (_,[cmd1,cmd2],_) -> do when (isJust $ lookupOpt "help") help -- this exits@@ -42,7 +41,7 @@ time1 <- test (1::Int) cmd1 time2 <- test (2::Int) cmd2 system $ cleanup ""- maybe (return ()) putStrLn (compareTimes time1 time2)+ maybe (return ()) putStrLn (compareTimes (cmd1, time1) (cmd2, time2)) _ -> help where fst3 (x,_,_) = x