feat: --max-bytes-used (#2)

+----------------------------------------------++---------------------------++-----------------------------+
|                                              ||     Time (s)              || Max bytes used              |
+==============================================++===========================++=============================+
|                                              || hledger-1.40 hledger-1.41 ||   hledger-1.40 hledger-1.41 |
+==============================================++===========================++=============================+
| -f examples/1ktxns-1kaccts.journal balance   ||         0.21         0.21 ||          3.84M        4.28M |
| -f examples/2ktxns-1kaccts.journal balance   ||         0.35         0.33 ||          7.43M        6.39M |
| -f examples/3ktxns-1kaccts.journal balance   ||         0.49         0.49 ||         10.48M       11.59M |
| -f examples/4ktxns-1kaccts.journal balance   ||         0.53         0.36 ||         14.61M       11.49M |
| -f examples/5ktxns-1kaccts.journal balance   ||         0.47         0.41 ||         18.32M       15.52M |
| -f examples/6ktxns-1kaccts.journal balance   ||         0.47         0.49 ||         21.72M       21.60M |
| -f examples/7ktxns-1kaccts.journal balance   ||         0.55         0.57 ||         22.35M       25.17M |
| -f examples/8ktxns-1kaccts.journal balance   ||         0.61         0.64 ||         22.28M       24.02M |
| -f examples/9ktxns-1kaccts.journal balance   ||         0.70         0.67 ||         31.41M       24.03M |
| -f examples/10ktxns-1kaccts.journal balance  ||         0.77         0.78 ||         36.00M       35.56M |
| -f examples/20ktxns-1kaccts.journal balance  ||         1.52         1.55 ||         72.62M       72.62M |
| -f examples/30ktxns-1kaccts.journal balance  ||         2.19         2.29 ||         85.87M       96.99M |
| -f examples/40ktxns-1kaccts.journal balance  ||         2.91         3.04 ||        120.17M      130.21M |
| -f examples/50ktxns-1kaccts.journal balance  ||         3.60         3.62 ||        129.01M      140.33M |
| -f examples/60ktxns-1kaccts.journal balance  ||         4.28         4.44 ||        162.47M      175.05M |
| -f examples/70ktxns-1kaccts.journal balance  ||         4.99         5.07 ||        195.87M      207.53M |
| -f examples/80ktxns-1kaccts.journal balance  ||         5.60         5.76 ||        211.37M      219.93M |
| -f examples/90ktxns-1kaccts.journal balance  ||         6.34         6.49 ||        241.11M      250.92M |
| -f examples/100ktxns-1kaccts.journal balance ||         6.90         7.01 ||        255.24M      264.18M |
+----------------------------------------------++---------------------------++-----------------------------+

Author: thomie

README.md

@@ -169,6 +169,7 @@ Options:
   -n, --iterations=N    run each test this many times [default: 1]
   -N, --cycles=N        run the whole suite this many times [default: 1]
   -p, --precision=N     show times with this many decimal places [default: 2]
+  -m, --max-bytes-used  measure max residency (Haskell programs compiled with `-rtsopts` only)
   -v, --verbose         show commands being run
   -V, --more-verbose    show command output
       --debug           show debug output for this program

quickbench.1.md

@@ -44,6 +44,9 @@ With -w, commands' first words are replaced with a new executable
 `-p, --precision=N`
 : show times with this many decimal places [default: 2]
 
+`-m, --max-bytes-used`
+: measure max residency (Haskell programs compiled with `-rtsopts` only)
+
 `-v, --verbose`
 : show commands being run
 

src/QuickBench.hs

@@ -1,13 +1,14 @@
-{-# LANGUAGE ScopedTypeVariables, QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables, QuasiQuotes, TupleSections, NumericUnderscores #-}
 
 module QuickBench (
   defaultMain
 )
 where
 
-import Control.Exception
+import Control.Exception hiding (handle)
 import Control.Monad
-import Data.List
+import Data.Functor
+import Data.List hiding (group)
 import Data.List.Split (splitOn)
 import Data.Maybe
 import Data.Time.Clock
@@ -22,6 +23,7 @@ import System.IO
 import System.Process
 import Text.Show.Pretty
 import Text.Printf
+import Text.Read
 import Text.Tabular
 import qualified Text.Tabular.AsciiArt as TA
 
@@ -45,6 +47,7 @@ Options:
   -n, --iterations=N    run each test this many times [default: 1]
   -N, --cycles=N        run the whole suite this many times [default: 1]
   -p, --precision=N     show times with this many decimal places [default: 2]
+  -m, --max-bytes-used  measure max residency (Haskell programs compiled with `-rtsopts` only)
   -v, --verbose         show commands being run
   -V, --more-verbose    show command output
       --debug           show debug output for this program
@@ -67,6 +70,7 @@ data Opts = Opts {
   ,iterations  :: Int
   ,cycles      :: Int
   ,precision   :: Int
+  ,maxBytesUsed:: Bool
   ,verbose     :: Bool
   ,moreVerbose :: Bool
   ,debug       :: Bool
@@ -97,6 +101,7 @@ getOpts = do
       ,precision   = precision'
       ,verbose     = flag "verbose"
       ,moreVerbose = flag "more-verbose"
+      ,maxBytesUsed= flag "max-bytes-used"
       ,debug       = flag "debug"
       ,help        = flag "help"
       ,clicmds     = args
@@ -170,14 +175,29 @@ getCurrentZonedTime = do
   tz <- getCurrentTimeZone
   return $ utcToZonedTime tz t
 
-runTestWithExes :: Opts -> [String] -> String -> IO [[Float]]
+runTestWithExes :: Opts -> [String] -> String -> IO [[(Float, Maybe Int)]]
 runTestWithExes opts exes cmd = mapM (runTestWithExe opts cmd) exes
 
-runTestWithExe :: Opts -> String -> String -> IO [Float]
+runTestWithExe :: Opts -> String -> String -> IO [(Float, Maybe Int)]
 runTestWithExe opts cmd exe = mapM (runTestOnce opts cmd exe) [1..iterations opts]
 
-runTestOnce :: Opts -> String -> String -> Int -> IO Float
-runTestOnce opts cmd exe iteration = do
+runTestOnce :: Opts -> String -> String -> Int -> IO (Float, Maybe Int)
+runTestOnce opts cmd exe iteration = if maxBytesUsed opts
+  then runTimeAndResidencyTest opts cmd exe iteration
+  else runTimeTest opts cmd exe iteration <&> (,Nothing)
+
+runTimeAndResidencyTest :: Opts -> String -> String -> Int -> IO (Float, Maybe Int)
+runTimeAndResidencyTest opts cmd exe iteration = withTempFile $ \name handle -> do
+  t <- runTimeTest opts (cmd ++ " +RTS --machine-readable -t" ++ name) exe iteration
+  _ <- hGetLine handle -- skip first line
+  stats <- hGetContents' handle
+  return (t, readMaybe stats >>= findMaxBytesUsed)
+ where
+  findMaxBytesUsed :: [(String, String)] -> Maybe Int
+  findMaxBytesUsed pairs = find ((== "max_bytes_used") . fst) pairs >>= readMaybe . snd
+
+runTimeTest :: Opts -> String -> String -> Int -> IO Float
+runTimeTest opts cmd exe iteration = do
   let (cmd',exe',args) = replaceExecutable exe cmd
   dbg opts $ printf "replaceExecutable: %s -> %s\n" (show (cmd,exe)) (show (cmd',exe',args))
   outv opts (show iteration ++ ": " ++ cmd' ++ "\n")
@@ -210,7 +230,7 @@ readProcessWithExitCode' exe args inp =
   readProcessWithExitCode exe args inp
     `catch` \(e :: IOException) -> return (ExitFailure 1, "", show e)
 
-printSummary :: Opts -> [String] -> [String] -> Int -> [[[Float]]] -> IO ()
+printSummary :: Opts -> [String] -> [String] -> Int -> [[[(Float, Maybe Int)]]] -> IO ()
 printSummary opts cmds exes cyc results = do
   out opts $ printf "\nBest times%s:\n" (if cycles opts > 1 then " "++show cyc else "")
   let t = maketable opts cmds' exes results
@@ -225,18 +245,63 @@ printSummary opts cmds exes cyc results = do
         [e] -> [c | (c,_,_) <- map (replaceExecutable e) cmds]
         _   -> map (unwords . drop 1 . words) cmds
 
-maketable :: Opts -> [String] -> [String] -> [[[Float]]] -> Table String String String
-maketable opts rownames colnames results = Table rowhdrs colhdrs rows
+maketable :: Opts -> [String] -> [String] -> [[[(Float, Maybe Int)]]] -> Table String String String
+maketable opts rownames colnames results = Table rowhdrs grouphdrs (firstrow:rows)
+ where
+  rowhdrs = makeRowHeaders rownames
+  grouphdrs = makeGroupHeaders opts colnames
+  firstrow = colnames ++ colnames
+  rows = map (makeRow opts) results
+
+makeRowHeaders :: [String] -> Header String
+makeRowHeaders rownames = Group DoubleLine [
+   Group NoLine [Header ""],
+   Group NoLine $ map Header $ padright rownames
+ ]
  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
 
+{-
+makeColumnHeaders :: Opts -> [String] -> Header String
+makeColumnHeaders opts colnames =
+  Group DoubleLine . replicate (if maxBytesUsed opts then 2 else 1) . Group SingleLine $ map Header colnames
+-}
+
+-- Workaround for https://github.com/bgamari/tabular/issues/4
+makeGroupHeaders :: Opts -> [String] -> Header String
+makeGroupHeaders opts colnames =
+  Group DoubleLine $ map (Group NoLine . headers) groups
+ where
+  groups = if maxBytesUsed opts then ["Time (s)", "Max bytes used"] else ["Time (s)"]
+  headers group = take (length colnames) . map Header $ group:repeat ""
+
+makeRow :: Opts -> [[(Float, Maybe Int)]] -> [String]
+makeRow opts results = if maxBytesUsed opts then times ++ bytes else times
+ where
+  times = map (showtime opts . minimum . map fst) results
+  bytes = map (showbytes opts . minimum . map (fromMaybe 0 . snd)) results
+
 showtime :: Opts -> (Float -> String)
 showtime opts = printf $ "%." ++ show (precision opts) ++ "f"
 
+showbytes :: Opts -> Int -> String
+showbytes opts n
+  | abs n >= 1000_000_000 = printf ("%." ++ show (precision opts) ++ "fG") (fromIntegral n / 1000_0000_0000 :: Double)
+  | abs n >= 1000_000 = printf ("%." ++ show (precision opts) ++ "fM") (fromIntegral n / 1000_0000 :: Double)
+  | abs n >= 1000 = printf ("%." ++ show (precision opts) ++ "fK") (fromIntegral n / 1000 :: Double)
+  | otherwise       = show n
+
+withTempFile :: (FilePath -> Handle -> IO a) -> IO a
+withTempFile action = do
+  tmp_dir <- getTemporaryDirectory >>= canonicalizePath
+  bracket
+    (openTempFile tmp_dir "quickbench-")
+    (\(name, handle) -> hClose handle >> ignoringIOErrors (removeFile name))
+    (uncurry action)
+ where
+  ignoringIOErrors = void . (try :: IO a -> IO (Either IOException a))
+
 istest :: String -> Bool
 istest s = not (null s' || ("#" `isPrefixOf` s')) where s' = clean s