slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tools: simplebench is now quickbench

Browse Source
This commit is contained in:
Simon Michael 2016-10-20 19:05:07 -07:00
parent bdf8f5ca88
commit 843c417079
5 changed files with 14 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Makefile
View File

@ -13,6 +13,7 @@
# #
# - stack, installs dependencies and drives cabal & ghc # - stack, installs dependencies and drives cabal & ghc
# - shelltestrunner (latest version from hackage or possibly git), runs functional tests # - shelltestrunner (latest version from hackage or possibly git), runs functional tests
# - quickbench (from git), runs benchmarks
# - hasktags, generates tag files for code navigation # - hasktags, generates tag files for code navigation
# - profiteur, renders profiles as interactive html # - profiteur, renders profiles as interactive html
# - hpack, generates cabal files from package.yaml files # - hpack, generates cabal files from package.yaml files
@ -58,9 +59,6 @@ PROFRTSFLAGS=-P
# COVCMD=test # COVCMD=test
# COVCMD=-f test-wf.csv print # COVCMD=-f test-wf.csv print
# executables to run during "make quickbench"
BENCHEXES=hledger-0.27 hledger-journalupdate hledger-parsedjournal hledger
# misc. system tools # misc. system tools
BROWSE=open BROWSE=open
# VIEWHTML=$(BROWSE) # VIEWHTML=$(BROWSE)
@ -504,10 +502,6 @@ dev-heap-upload:
# ) # )
# $(GHC) tools/doctest.hs # $(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 \ # tools/criterionbench: tools/criterionbench.hs \
# $(call def-help,tools/criterionbench,\ # $(call def-help,tools/criterionbench,\
# build the criterion-based benchmark runner. Requires criterion.\ # build the criterion-based benchmark runner. Requires criterion.\
@ -678,13 +672,14 @@ cabalfiletest: \
# && echo $@ PASSED) || echo $@ FAILED # && echo $@ PASSED) || echo $@ FAILED
# # && cabal upload dist/$$p-$(VERSION).tar.gz --check -v3 \ # # && 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,\ $(call def-help,quickbench,\
run simple performance benchmarks without saving results\ 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) quickbench -v -w $(BENCHEXES)
@rm -f benchresults.*
# bench: samplejournals tests/bench.tests tools/simplebench \ # bench: samplejournals tests/bench.tests tools/simplebench \
# $(call def-help,bench,\ # $(call def-help,bench,\
@ -1169,9 +1164,6 @@ $(call def-help-subsection,RELEASING:)
# # # #
# # - The .version file must be updated manually before a release. # # - 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. # # - "make" updates the version in most other places, and defines PATCHES.
# # Note "cabal build" should also do this but doesn't yet. # # Note "cabal build" should also do this but doesn't yet.
# # # #
@ -1303,7 +1295,6 @@ tagrelease: \
# $(call def-help,showreleasestats stats,\ # $(call def-help,showreleasestats stats,\
# show project stats useful for release notes\ # show project stats useful for release notes\
# ) # )
# # simplebench
# # showerrors # # showerrors
# FROMTAG=. # FROMTAG=.

178
hledger/bench/SimpleBench.hs
View File

@ -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"

16
hledger/bench/bench.hs
View File

@ -1,10 +1,10 @@
-- bench -- bench
-- By default, show approximate times for some standard hledger operations on a sample journal. -- By default, show approximate times for some standard hledger operations on a sample journal.
-- With --criterion, show accurate times (slow). -- 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 Criterion.Main (defaultMainWith, defaultConfig, bench, nfIO)
import SimpleBench (defaultMain) -- import QuickBench (defaultMain)
import System.Directory (getCurrentDirectory) import System.Directory (getCurrentDirectory)
import System.Environment (getArgs, withArgs) import System.Environment (getArgs, withArgs)
import System.Info (os) import System.Info (os)
@ -20,13 +20,13 @@ outputfile = "/dev/null" -- hide output of benchmarked commands (XXX unixism)
-- outputfile = "-" -- show output of benchmarked commands -- outputfile = "-" -- show output of benchmarked commands
main = do main = do
-- withArgs ["--simplebench"] $ do -- withArgs ["--quickbench"] $ do
-- withArgs ["--criterion"] $ do -- withArgs ["--criterion"] $ do
args <- getArgs args <- getArgs
if "--criterion" `elem` args if "--criterion" `elem` args
then withArgs [] benchWithCriterion then withArgs [] benchWithCriterion
else if "--simplebench" `elem` args else if "--quickbench" `elem` args
then benchWithSimplebench then benchWithQuickbench
else benchWithTimeit else benchWithTimeit
benchWithTimeit = do benchWithTimeit = do
@ -57,12 +57,12 @@ benchWithCriterion = do
bench ("stats") $ nfIO $ stats opts j bench ("stats") $ nfIO $ stats opts j
] ]
benchWithSimplebench = do benchWithQuickbench = do
let whichcmd = if os == "mingw32" then "where" else "which" let whichcmd = if os == "mingw32" then "where" else "which"
exe <- init <$> readProcess whichcmd ["hledger"] "" exe <- init <$> readProcess whichcmd ["hledger"] ""
pwd <- getCurrentDirectory pwd <- getCurrentDirectory
printf "Benchmarking %s in %s with simplebench and shell\n" exe pwd printf "Benchmarking %s in %s with quickbench and shell\n" exe pwd
flip withArgs SimpleBench.defaultMain [ flip withArgs QuickBench.defaultMain [
"-fbench/default.bench" "-fbench/default.bench"
,"-v" ,"-v"
,"hledger" ,"hledger"

2
hledger/hledger.cabal
View File

@ -283,8 +283,6 @@ benchmark bench
hs-source-dirs: hs-source-dirs:
bench bench
main-is: bench.hs 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 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 default-language: Haskell2010
build-depends: build-depends:

173
tools/simplebench.hs
View File

@ -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"