From 01db48fcfce6d3683cdb63bf167da5539c3f47e6 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 25 Jun 2015 15:54:45 -0700
Subject: [PATCH] cli: a more robust and featureful bench test

The bench script invoked by cabal bench or stack bench now links the
benchmarked code directly, avoiding any dependence on the shell and
$PATH. Also, it reports the journal parse time and the various reports
on the parsed data separately, and runs quicker.

You can get more accurate benchmark times by running with --criterion.
This will usually give much the same numbers and takes much longer.

Benchmarking via simplebench is still available, by running with
--simplebench. In this mode it benchmarks whatever commands are
configured in bench/default.bench. A disadvantage is that it uses the
first "hledger" executable in $PATH, so check which one it reports.
---
 hledger/bench/bench.hs | 84 +++++++++++++++++++++++++++++++++++++-----
 hledger/hledger.cabal  |  2 +
 stack.yaml             |  3 +-
 3 files changed, 78 insertions(+), 11 deletions(-)

diff --git a/hledger/bench/bench.hs b/hledger/bench/bench.hs
index a4581cc76..0d01ea595 100644
--- a/hledger/bench/bench.hs
+++ b/hledger/bench/bench.hs
@@ -1,15 +1,79 @@
+-- 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.
+
 import Control.Concurrent (threadDelay)
+import Criterion.Main     (defaultMainWith, defaultConfig, bench, nfIO)
+-- import Criterion.Types
 import SimpleBench        (defaultMain)
-import System.Environment (withArgs)
+import System.Directory   (getCurrentDirectory)
+import System.Environment (getArgs, withArgs)
+import System.Info        (os)
+-- import System.IO          (hFlush, stdout)
+import System.Process     (readProcess)
+import System.TimeIt      (timeItT)
+import Text.Printf
+import Hledger.Cli
+
+-- sample journal file to use for benchmarks
+inputfile = "bench/10000x1000x10.journal"
+
+outputfile = "/dev/null" -- hide output of benchmarked commands (XXX unixism)
+-- outputfile = "-" -- show output of benchmarked commands
+
+-- a delay to avoid truncation of final output by "stack bench"
+-- https://github.com/commercialhaskell/stack/issues/413
+stackFinalOutputDelaySeconds = 0 -- 10
 
 main = do
-  -- expects to be run from the parent directory, as by cabal
-  withArgs [
-    "-fbench/default.bench"
-   ,"dist/build/hledger/hledger"
-   -- ,"-v"
-   ] defaultMain
+ -- withArgs ["--simplebench"] $ do
+ -- withArgs ["--criterion"] $ do
+  args <- getArgs
+  if "--criterion" `elem` args
+    then withArgs [] benchWithCriterion
+    else if "--simplebench" `elem` args
+         then benchWithSimplebench
+         else benchWithTimeit
+  -- hFlush stdout
+  threadDelay (stackFinalOutputDelaySeconds * 1000000)
 
-  -- a little delay to avoid truncation of final output by stack
-  -- in a slow-rendering terminal, such as an emacs shell
-  threadDelay 500000
+benchWithTimeit = do
+  getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n"
+  let opts = defcliopts{output_file_=Just outputfile}
+  (t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFile Nothing Nothing True inputfile
+  (t1,_) <- timeit ("print") $ print' opts j
+  (t2,_) <- timeit ("register") $ register opts j
+  (t3,_) <- timeit ("balance") $ balance  opts j
+  (t4,_) <- timeit ("stats") $ stats opts j
+  printf "Total: %0.2fs\n" (sum [t0,t1,t2,t3,t4])
+
+timeit :: String -> IO a -> IO (Double, a)
+timeit name action = do
+  printf "%s%s" name (replicate (40 - length name) ' ')
+  (t,a) <- timeItT action
+  printf "[%.2fs]\n" t
+  return (t,a)
+
+benchWithCriterion = do
+  getCurrentDirectory >>= printf "Benchmarking hledger in %s with criterion\n"
+  let opts = defcliopts{output_file_=Just "/dev/null"}
+  j <- either error id <$> readJournalFile Nothing Nothing True inputfile
+  Criterion.Main.defaultMainWith defaultConfig $ [
+    bench ("read "++inputfile) $ nfIO $ (either error const <$> readJournalFile Nothing Nothing True inputfile),
+    bench ("print")            $ nfIO $ print'   opts j,
+    bench ("register")         $ nfIO $ register opts j,
+    bench ("balance")          $ nfIO $ balance  opts j,
+    bench ("stats")            $ nfIO $ stats    opts j
+    ]
+
+benchWithSimplebench = 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 [
+     "-fbench/default.bench"
+    ,"-v"
+    ,"hledger"
+    ] 
diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal
index 0f3d6664b..e57710184 100644
--- a/hledger/hledger.cabal
+++ b/hledger/hledger.cabal
@@ -214,8 +214,10 @@ benchmark bench
                     hledger,
                     base >= 4.3 && < 5,
                     base-compat >= 0.8.1,
+                    criterion,
                     html,
                     tabular >= 0.2 && < 0.3,
+                    timeit,
                     process,
                     filepath,
                     directory
diff --git a/stack.yaml b/stack.yaml
index 293789534..f0f2e6820 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -4,4 +4,5 @@ packages:
 - hledger-web
 flags: {}
 resolver: nightly-2015-06-17
-extra-deps: []
+extra-deps:
+- timeit-1.0.0.0