mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-16 00:37:33 +03:00
tools: simplebench is now quickbench
This commit is contained in:
Simon Michael
parent
bdf8f5ca88
commit
843c417079
21
Makefile
21
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=.
|
||||
|
||||
@ -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"
|
||||
@ -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"
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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"
|
||||
Loading…
Reference in New Issue
Block a user