From c709a22c648c3667e7d5242fb5825eed74794dca Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 20 Nov 2021 20:51:21 -1000 Subject: [PATCH] imp: stats: also show run time and throughput CliOpts has a new field, progstarttime_. Currently the new stats are always printed on stdout, ignoring --output-file/--output-format. --- hledger/Hledger/Cli/CliOptions.hs | 3 +++ hledger/Hledger/Cli/Commands/Stats.hs | 26 ++++++++++++++------- hledger/Hledger/Cli/Commands/Stats.md | 33 +++++++++++++++++---------- hledger/Hledger/Cli/Main.hs | 5 +++- 4 files changed, 46 insertions(+), 21 deletions(-) diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 0cecba70c..466442d7a 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -102,6 +102,7 @@ import Text.Megaparsec.Char import Hledger import Hledger.Cli.DocFiles import Hledger.Cli.Version +import Data.Time.Clock.POSIX (POSIXTime) -- common cmdargs flags @@ -441,6 +442,7 @@ data CliOpts = CliOpts { -- 1. the COLUMNS env var, if set -- 2. the width reported by the terminal, if supported -- 3. the default (80) + ,progstarttime_ :: POSIXTime } deriving (Show) instance Default CliOpts where def = defcliopts @@ -458,6 +460,7 @@ defcliopts = CliOpts , no_new_accounts_ = False , width_ = Nothing , available_width_ = defaultWidth + , progstarttime_ = 0 } -- | Default width for hledger console output, when not otherwise specified. diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index e6bf93315..656e48b9b 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -6,6 +6,7 @@ Print some statistics for the journal. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NamedFieldPuns #-} module Hledger.Cli.Commands.Stats ( statsmode @@ -29,6 +30,7 @@ import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Utils (writeOutputLazyText) import Text.Tabular.AsciiWide +import Data.Time.Clock.POSIX (getPOSIXTime) statsmode = hledgerCommandMode @@ -42,24 +44,31 @@ statsmode = hledgerCommandMode -- like Register.summarisePostings -- | Print various statistics for the journal. stats :: CliOpts -> Journal -> IO () -stats opts@CliOpts{reportspec_=rspec} j = do +stats opts@CliOpts{reportspec_=rspec, progstarttime_} j = do let today = _rsDay rspec q = _rsQuery rspec l = ledgerFromJournal q j reportspan = ledgerDateSpan l `spanDefaultsFrom` queryDateSpan False q intervalspans = splitSpan (interval_ $ _rsReportOpts rspec) reportspan showstats = showLedgerStats l today - s = unlinesB $ map showstats intervalspans - writeOutputLazyText opts $ TB.toLazyText s + (ls, txncounts) = unzip $ map showstats intervalspans + numtxns = sum txncounts + b = unlinesB ls + writeOutputLazyText opts $ TB.toLazyText b + t <- getPOSIXTime + let dt = t - progstarttime_ + printf "Run time : %.2f s\n" (realToFrac dt :: Float) + printf "Throughput : %.0f txns/s\n" (fromIntegral numtxns / realToFrac dt :: Float) -showLedgerStats :: Ledger -> Day -> DateSpan -> TB.Builder +showLedgerStats :: Ledger -> Day -> DateSpan -> (TB.Builder, Int) showLedgerStats l today span = - unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stats + (unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stats + ,tnum) where showRow (label, value) = Group NoLine $ map (Header . textCell TopLeft) [fitText (Just w1) (Just w1) False True label `T.append` ": ", T.pack value] w1 = maximum $ map (T.length . fst) stats - stats = [ + (stats, tnum) = ([ ("Main file", path) -- ++ " (from " ++ source ++ ")") ,("Included files", unlines $ drop 1 $ journalFilePaths j) ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) @@ -75,7 +84,8 @@ showLedgerStats l today span = -- Unmarked transactions : %(unmarked)s -- Days since reconciliation : %(reconcileelapsed)s -- Days since last transaction : %(recentelapsed)s - ] + ] + ,tnum) where j = ljournal l path = journalFilePath j @@ -90,7 +100,7 @@ showLedgerStats l today span = where days' = abs days direction | days >= 0 = "days ago" :: String | otherwise = "days from now" - tnum = length ts + tnum = length ts -- Integer would be better start (DateSpan (Just d) _) = show d start _ = "" end (DateSpan _ (Just d)) = show d diff --git a/hledger/Hledger/Cli/Commands/Stats.md b/hledger/Hledger/Cli/Commands/Stats.md index ae44856a0..aef736bf2 100644 --- a/hledger/Hledger/Cli/Commands/Stats.md +++ b/hledger/Hledger/Cli/Commands/Stats.md @@ -1,27 +1,36 @@ stats\ -Show some journal statistics. +Show journal and performance statistics. _FLAGS The stats command displays summary information for the whole journal, or a matched part of it. With a [reporting interval](#reporting-interval), -it shows a report for each report period. +it shows a report for each report period. + +At the end, it shows (in the terminal) the overall run time and number of +transactions processed per second. Note these are approximate and will vary +based on machine, current load, data size, hledger version, haskell lib +versions, GHC version.. but they may be of interest. The `stats` command's +run time is similar to that of a single-column balance report. Example: ```shell -$ hledger stats -Main journal file : /src/hledger/examples/sample.journal -Included journal files : -Transactions span : 2008-01-01 to 2009-01-01 (366 days) -Last transaction : 2008-12-31 (2333 days ago) -Transactions : 5 (0.0 per day) +$ hledger stats -f examples/1000x1000x10.journal +Main file : /Users/simon/src/hledger/examples/1000x1000x10.journal +Included files : +Transactions span : 2000-01-01 to 2002-09-27 (1000 days) +Last transaction : 2002-09-26 (6995 days ago) +Transactions : 1000 (1.0 per day) Transactions last 30 days: 0 (0.0 per day) Transactions last 7 days : 0 (0.0 per day) -Payees/descriptions : 5 -Accounts : 8 (depth 3) -Commodities : 1 ($) -Market prices : 12 ($) +Payees/descriptions : 1000 +Accounts : 1000 (depth 10) +Commodities : 26 (A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z) +Market prices : 1000 (A) + +Run time : 0.12 s +Throughput : 8342 txns/s ``` This command also supports diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 8d5ac98f7..b8e42d71e 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -51,6 +51,7 @@ import System.Process import Text.Printf import Hledger.Cli +import Data.Time.Clock.POSIX (getPOSIXTime) -- | The overall cmdargs mode describing hledger's command-line options and subcommands. @@ -96,6 +97,7 @@ mainmode addons = defMode { -- | Let's go! main :: IO () main = do + progstarttime <- getPOSIXTime -- Choose and run the appropriate internal or external command based -- on the raw command-line arguments, cmdarg's interpretation of @@ -129,7 +131,8 @@ main = do let addons = filter (not . (`elem` builtinCommandNames) . dropExtension) addons' -- parse arguments with cmdargs - opts <- argsToCliOpts args addons + opts' <- argsToCliOpts args addons + let opts = opts'{progstarttime_=progstarttime} -- select an action and run it. let