From 843c4170794e5c8c3294103e77a9e35b99a0d00e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 20 Oct 2016 19:05:07 -0700 Subject: [PATCH] tools: simplebench is now quickbench --- Makefile | 21 ++--- hledger/bench/SimpleBench.hs | 178 ----------------------------------- hledger/bench/bench.hs | 16 ++-- hledger/hledger.cabal | 2 - tools/simplebench.hs | 173 ---------------------------------- 5 files changed, 14 insertions(+), 376 deletions(-) delete mode 100755 hledger/bench/SimpleBench.hs delete mode 100755 tools/simplebench.hs diff --git a/Makefile b/Makefile index 64f470289..0d343864c 100644 --- a/Makefile +++ b/Makefile @@ -13,6 +13,7 @@ # # - stack, installs dependencies and drives cabal & ghc # - shelltestrunner (latest version from hackage or possibly git), runs functional tests +# - quickbench (from git), runs benchmarks # - hasktags, generates tag files for code navigation # - profiteur, renders profiles as interactive html # - hpack, generates cabal files from package.yaml files @@ -58,9 +59,6 @@ PROFRTSFLAGS=-P # COVCMD=test # COVCMD=-f test-wf.csv print -# executables to run during "make quickbench" -BENCHEXES=hledger-0.27 hledger-journalupdate hledger-parsedjournal hledger - # misc. system tools BROWSE=open # VIEWHTML=$(BROWSE) @@ -504,10 +502,6 @@ dev-heap-upload: # ) # $(GHC) tools/doctest.hs -tools/simplebench: tools/simplebench.hs \ - $(call def-help,tools/simplebench, build the standalone generic benchmark runner. Requires libs installed by stack build --bench. ) - $(STACK) exec -- $(GHC) tools/simplebench.hs - # tools/criterionbench: tools/criterionbench.hs \ # $(call def-help,tools/criterionbench,\ # build the criterion-based benchmark runner. Requires criterion.\ @@ -678,13 +672,14 @@ cabalfiletest: \ # && echo $@ PASSED) || echo $@ FAILED # # && cabal upload dist/$$p-$(VERSION).tar.gz --check -v3 \ -quickbench: samplejournals bench.tests tools/simplebench \ +BENCHEXES=hledger-0.27,hledger + +quickbench: samplejournals bench.sh \ $(call def-help,quickbench,\ run simple performance benchmarks without saving results\ - Requires some commands defined in bench.tests and some BENCHEXES defined above.\ + Requires some commands defined in bench.sh\ ) - tools/simplebench -v -fbench.tests $(BENCHEXES) - @rm -f benchresults.* + quickbench -v -w $(BENCHEXES) # bench: samplejournals tests/bench.tests tools/simplebench \ # $(call def-help,bench,\ @@ -1169,9 +1164,6 @@ $(call def-help-subsection,RELEASING:) # # # # - The .version file must be updated manually before a release. # # -# # - "make simplebench" depends on version numbers in BENCHEXES, these also -# # must be updated manually. -# # # # - "make" updates the version in most other places, and defines PATCHES. # # Note "cabal build" should also do this but doesn't yet. # # @@ -1303,7 +1295,6 @@ tagrelease: \ # $(call def-help,showreleasestats stats,\ # show project stats useful for release notes\ # ) -# # simplebench # # showerrors # FROMTAG=. diff --git a/hledger/bench/SimpleBench.hs b/hledger/bench/SimpleBench.hs deleted file mode 100755 index 77d3e3066..000000000 --- a/hledger/bench/SimpleBench.hs +++ /dev/null @@ -1,178 +0,0 @@ --- a quick librarification of tools/simplebench.hs for cabal benchmarking - --- #!/usr/bin/env runhaskell -{- -bench.hs - simple benchmarking of command-line programs. -Requires html and tabular. -Simon Michael 2008-2015 - -Example: - -$ simplebench.hs --help -... -$ cat - >bench.tests --f sample.ledger -s balance --f ~/.ledger -s balance -$ simplebench.hs -v hledger "ledger --no-cache" ledger -Using bench.tests -Running 2 tests 2 times in . with 3 executables at 2008-11-26 18:52:15.776357 UTC: -1: hledger -f sample.ledger -s balance [0.02s] -2: hledger -f sample.ledger -s balance [0.01s] -1: ledger --no-cache -f sample.ledger -s balance [0.02s] -2: ledger --no-cache -f sample.ledger -s balance [0.02s] -1: ledger -f sample.ledger -s balance [0.02s] -2: ledger -f sample.ledger -s balance [0.02s] -1: hledger -f ~/.ledger -s balance [3.56s] -2: hledger -f ~/.ledger -s balance [3.56s] -1: ledger --no-cache -f ~/.ledger -s balance [0.10s] -2: ledger --no-cache -f ~/.ledger -s balance [0.10s] -1: ledger -f ~/.ledger -s balance [0.10s] -2: ledger -f ~/.ledger -s balance [0.10s] - -Summary (best iteration): - - || hledger | ledger --no-cache | ledger -============================++=========+===================+======= --f sample.ledger -s balance || 0.01 | 0.02 | 0.02 - -f ~/.ledger -s balance || 3.56 | 0.10 | 0.10 - --} - -module SimpleBench -where - -import Data.List -import System.Environment --- import System.FilePath -import System.Process -import System.IO -import Text.Tabular -import qualified Text.Tabular.AsciiArt as TA --- import qualified Text.Tabular.Html as TH --- import Text.Html ((+++), renderHtml, stringToHtml) -import System.Exit -import Text.Printf -import Data.Time.Clock -import Data.Time.Format () -import Control.Monad -import System.Console.GetOpt - -usagehdr = "bench [-f testsfile] [-n iterations] [-p precision] executable1 [executable2 ...]\n" ++ - "\n" ++ - "Run some functional tests with each of the specified executables,\n" ++ - "where a test is \"zero or more arguments supported by all executables\",\n" ++ - "and report the best execution times.\n" - -options = [ - Option "f" ["testsfile"] (ReqArg File "testsfile") "file containing tests, one per line, default: bench.tests" - ,Option "n" ["iterations"] (ReqArg Num "iterations") "number of test iterations to run, default: 1" - ,Option "p" ["precision"] (ReqArg Prec "precision") "show times with this precision, default: 2" - ,Option "v" ["verbose"] (NoArg Verbose) "show intermediate results" - ,Option "h" ["help"] (NoArg Help) "show this help" - ] - -usageftr = "\n" ++ - "Tips:\n" ++ - "- executables may have arguments if enclosed in quotes\n" ++ - "- tests can be commented out with #\n" ++ - "- results are saved in benchresults.{html,txt}\n" - -usage = usageInfo usagehdr options ++ usageftr - --- an option value -data Opt = File {value::String} - | Num {value::String} - | Prec {value::String} --- I don't know how optValuesForConstructor etc. can have that --- type signature with these, but it works.. --- | Some Int - | Verbose - | Help - deriving (Eq,Show) - --- option value getters. -fileopt :: [Opt] -> String -fileopt = optValueWithDefault File "bench.tests" - -precisionopt :: [Opt] -> Int -precisionopt = read . optValueWithDefault Prec "2" - -numopt :: [Opt] -> Int -numopt = read . optValueWithDefault Num "1" - -verboseopt :: [Opt] -> Bool -verboseopt = (Verbose `elem`) - --- options utilities -parseargs :: [String] -> ([Opt],[String]) -parseargs as = - case (getOpt Permute options as) of - (opts,args,[]) -> (opts,args) - (_,_,errs) -> error (concat errs ++ usage) - -optValueWithDefault :: (String -> Opt) -> String -> [Opt] -> String -optValueWithDefault optcons def opts = - last $ def : optValuesForConstructor optcons opts - -optValuesForConstructor :: (String -> Opt) -> [Opt] -> [String] -optValuesForConstructor optcons opts = concatMap get opts - where get o = [v | optcons v == o] where v = value o - -defaultMain = do - args <- getArgs - let (opts,exes) = parseargs args - when (null exes) $ error $ "at least one executable needed\n" ++ usage - let (file, num) = (fileopt opts, numopt opts) - tests <- liftM (filter istest . lines) (readFile file) - now <- getCurrentTime - putStrLn $ printf "Using %s" file - putStrLn $ printf "Running %d tests %d times with %d executables at %s:" - (length tests) num (length exes) (show now) - let doexe t e = mapM (doiteration opts t e) [1..num] - let dotest t = mapM (doexe t) exes - hSetBuffering stdout NoBuffering - results <- mapM dotest tests - summarise opts tests exes results - -istest s = not (null s' || ("#" `isPrefixOf` s')) where s' = clean s -clean = unwords . words - -doiteration :: [Opt] -> String -> String -> Int -> IO Float -doiteration opts test exe iteration = do - let cmd = unwords [exe,clean test] - when (verboseopt opts) $ putStr $ show iteration ++ ": " ++ cmd - hFlush stdout - t <- time cmd - when (verboseopt opts) $ printf "\t[%ss]\n" (showtime opts t) - return t - -time :: String -> IO Float -time cmd = do - t1 <- getCurrentTime - ret <- system $ cmd ++ " >/dev/null 2>&1" - case ret of - ExitSuccess -> return () - ExitFailure f -> putStr $ printf " (error %d)" f - t2 <- getCurrentTime - return $ realToFrac $ diffUTCTime t2 t1 - -summarise :: [Opt] -> [String] -> [String] -> [[[Float]]] -> IO () -summarise opts tests exes results = do - putStrLn "\nSummary (best iteration):\n" - let t = maketable opts tests exes results - putStrLn $ TA.render id id id t - -- let outname = "benchresults" - -- writeFile (outname <.> "txt") $ TA.render id id id t - -- writeFile (outname <.> "html") $ renderHtml $ TH.css TH.defaultCss +++ TH.render stringToHtml stringToHtml stringToHtml t - -maketable :: [Opt] -> [String] -> [String] -> [[[Float]]] -> Table String String String -maketable opts rownames colnames results = Table rowhdrs colhdrs rows - where - rowhdrs = Group NoLine $ map Header $ padright rownames - colhdrs = Group SingleLine $ map Header colnames - rows = map (map (showtime opts . minimum)) results - padright ss = map (printf (printf "%%-%ds" w)) ss - where w = maximum $ map length ss - -showtime :: [Opt] -> (Float -> String) -showtime opts = printf $ "%." ++ show (precisionopt opts) ++ "f" diff --git a/hledger/bench/bench.hs b/hledger/bench/bench.hs index 123c22954..f76e1bcd6 100644 --- a/hledger/bench/bench.hs +++ b/hledger/bench/bench.hs @@ -1,10 +1,10 @@ -- bench -- By default, show approximate times for some standard hledger operations on a sample journal. -- With --criterion, show accurate times (slow). --- With --simplebench, show approximate times for the commands in default.bench, using the first hledger executable on $PATH. +-- TODO With --quickbench, show approximate times for the commands in default.bench, using the first hledger executable on $PATH. import Criterion.Main (defaultMainWith, defaultConfig, bench, nfIO) -import SimpleBench (defaultMain) +-- import QuickBench (defaultMain) import System.Directory (getCurrentDirectory) import System.Environment (getArgs, withArgs) import System.Info (os) @@ -20,13 +20,13 @@ outputfile = "/dev/null" -- hide output of benchmarked commands (XXX unixism) -- outputfile = "-" -- show output of benchmarked commands main = do - -- withArgs ["--simplebench"] $ do + -- withArgs ["--quickbench"] $ do -- withArgs ["--criterion"] $ do args <- getArgs if "--criterion" `elem` args then withArgs [] benchWithCriterion - else if "--simplebench" `elem` args - then benchWithSimplebench + else if "--quickbench" `elem` args + then benchWithQuickbench else benchWithTimeit benchWithTimeit = do @@ -57,12 +57,12 @@ benchWithCriterion = do bench ("stats") $ nfIO $ stats opts j ] -benchWithSimplebench = do +benchWithQuickbench = do let whichcmd = if os == "mingw32" then "where" else "which" exe <- init <$> readProcess whichcmd ["hledger"] "" pwd <- getCurrentDirectory - printf "Benchmarking %s in %s with simplebench and shell\n" exe pwd - flip withArgs SimpleBench.defaultMain [ + printf "Benchmarking %s in %s with quickbench and shell\n" exe pwd + flip withArgs QuickBench.defaultMain [ "-fbench/default.bench" ,"-v" ,"hledger" diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 894682caf..158cee18a 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -283,8 +283,6 @@ benchmark bench hs-source-dirs: bench main-is: bench.hs - other-modules: - SimpleBench ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans default-language: Haskell2010 build-depends: diff --git a/tools/simplebench.hs b/tools/simplebench.hs deleted file mode 100755 index c27a8ef2b..000000000 --- a/tools/simplebench.hs +++ /dev/null @@ -1,173 +0,0 @@ -#!/usr/bin/env runhaskell -{- -bench.hs - simple benchmarking of command-line programs. -Requires html and tabular. -Simon Michael 2008-2013 - -Example: - -$ simplebench.hs --help -... -$ cat - >bench.tests --f sample.ledger -s balance --f ~/.ledger -s balance -$ simplebench.hs -v hledger "ledger --no-cache" ledger -Using bench.tests -Running 2 tests 2 times in . with 3 executables at 2008-11-26 18:52:15.776357 UTC: -1: hledger -f sample.ledger -s balance [0.02s] -2: hledger -f sample.ledger -s balance [0.01s] -1: ledger --no-cache -f sample.ledger -s balance [0.02s] -2: ledger --no-cache -f sample.ledger -s balance [0.02s] -1: ledger -f sample.ledger -s balance [0.02s] -2: ledger -f sample.ledger -s balance [0.02s] -1: hledger -f ~/.ledger -s balance [3.56s] -2: hledger -f ~/.ledger -s balance [3.56s] -1: ledger --no-cache -f ~/.ledger -s balance [0.10s] -2: ledger --no-cache -f ~/.ledger -s balance [0.10s] -1: ledger -f ~/.ledger -s balance [0.10s] -2: ledger -f ~/.ledger -s balance [0.10s] - -Summary (best iteration): - - || hledger | ledger --no-cache | ledger -============================++=========+===================+======= --f sample.ledger -s balance || 0.01 | 0.02 | 0.02 - -f ~/.ledger -s balance || 3.56 | 0.10 | 0.10 - --} - -import Data.List -import System.Environment -import System.FilePath -import System.Process -import System.IO -import Text.Tabular -import qualified Text.Tabular.AsciiArt as TA -import qualified Text.Tabular.Html as TH -import Text.Html ((+++), renderHtml, stringToHtml) -import System.Exit -import Text.Printf -import Data.Time.Clock -import Data.Time.Format () -import Control.Monad -import System.Console.GetOpt - -usagehdr = "bench [-f testsfile] [-n iterations] [-p precision] executable1 [executable2 ...]\n" ++ - "\n" ++ - "Run some functional tests with each of the specified executables,\n" ++ - "where a test is \"zero or more arguments supported by all executables\",\n" ++ - "and report the best execution times.\n" - -options = [ - Option "f" ["testsfile"] (ReqArg File "testsfile") "file containing tests, one per line, default: bench.tests" - ,Option "n" ["iterations"] (ReqArg Num "iterations") "number of test iterations to run, default: 2" - ,Option "p" ["precision"] (ReqArg Prec "precision") "show times with this precision, default: 2" - ,Option "v" ["verbose"] (NoArg Verbose) "show intermediate results" - ,Option "h" ["help"] (NoArg Help) "show this help" - ] - -usageftr = "\n" ++ - "Tips:\n" ++ - "- executables may have arguments if enclosed in quotes\n" ++ - "- tests can be commented out with #\n" ++ - "- results are saved in benchresults.{html,txt}\n" - -usage = usageInfo usagehdr options ++ usageftr - --- an option value -data Opt = File {value::String} - | Num {value::String} - | Prec {value::String} --- I don't know how optValuesForConstructor etc. can have that --- type signature with these, but it works.. --- | Some Int - | Verbose - | Help - deriving (Eq,Show) - --- option value getters. -fileopt :: [Opt] -> String -fileopt = optValueWithDefault File "bench.tests" - -precisionopt :: [Opt] -> Int -precisionopt = read . optValueWithDefault Prec "2" - -numopt :: [Opt] -> Int -numopt = read . optValueWithDefault Num "2" - -verboseopt :: [Opt] -> Bool -verboseopt = (Verbose `elem`) - --- options utilities -parseargs :: [String] -> ([Opt],[String]) -parseargs as = - case (getOpt Permute options as) of - (opts,args,[]) -> (opts,args) - (_,_,errs) -> error (concat errs ++ usage) - -optValueWithDefault :: (String -> Opt) -> String -> [Opt] -> String -optValueWithDefault optcons def opts = - last $ def : optValuesForConstructor optcons opts - -optValuesForConstructor :: (String -> Opt) -> [Opt] -> [String] -optValuesForConstructor optcons opts = concatMap get opts - where get o = [v | optcons v == o] where v = value o - -main = do - args <- getArgs - let (opts,exes) = parseargs args - when (null exes) $ error $ "at least one executable needed\n" ++ usage - let (file, num) = (fileopt opts, numopt opts) - tests <- liftM (filter istest . lines) (readFile file) - now <- getCurrentTime - putStrLn $ printf "Using %s" file - putStrLn $ printf "Running %d tests %d times with %d executables at %s:" - (length tests) num (length exes) (show now) - let doexe t e = mapM (doiteration opts t e) [1..num] - let dotest t = mapM (doexe t) exes - hSetBuffering stdout NoBuffering - results <- mapM dotest tests - summarise opts tests exes results - -istest s = not (null s' || ("#" `isPrefixOf` s')) where s' = clean s -clean = unwords . words - -doiteration :: [Opt] -> String -> String -> Int -> IO Float -doiteration opts test exe iteration = do - let cmd = unwords [exe,clean test] - when (verboseopt opts) $ putStr $ show iteration ++ ": " ++ cmd - hFlush stdout - t <- time cmd - when (verboseopt opts) $ printf "\t[%ss]\n" (showtime opts t) - return t - -time :: String -> IO Float -time cmd = do - t1 <- getCurrentTime - ret <- system $ cmd ++ " >/dev/null 2>&1" - case ret of - ExitSuccess -> return () - ExitFailure f -> putStr $ printf " (error %d)" f - t2 <- getCurrentTime - return $ realToFrac $ diffUTCTime t2 t1 - -summarise :: [Opt] -> [String] -> [String] -> [[[Float]]] -> IO () -summarise opts tests exes results = do - putStrLn "\nSummary (best iteration):\n" - let t = maketable opts tests exes results - putStrLn $ TA.render id id id t - let outname = "benchresults" - writeFile (outname <.> "txt") $ TA.render id id id t - writeFile (outname <.> "html") $ renderHtml $ TH.css TH.defaultCss +++ TH.render stringToHtml stringToHtml stringToHtml t - -maketable :: [Opt] -> [String] -> [String] -> [[[Float]]] -> Table String String String -maketable opts rownames colnames results = Table rowhdrs colhdrs rows - where - rowhdrs = Group NoLine $ map Header $ padright rownames - colhdrs = Group SingleLine $ map Header colnames - rows = map (map (showtime opts . minimum)) results - padright ss = map (printf (printf "%%-%ds" w)) ss - where w = maximum $ map length ss - -showtime :: [Opt] -> (Float -> String) -showtime opts = printf $ "%." ++ show (precisionopt opts) ++ "f"