5e7b69356f
instead of a list of Amounts. No longer export Mixed constructor, to keep API clean (if you really need it, you can import it directly from Hledger.Data.Types). We also ensure the JSON representation of MixedAmount doesn't change: it is stored as a normalised list of Amounts. This commit improves performance. Here are some indicative results. hledger reg -f examples/10000x1000x10.journal - Maximum residency decreases from 65MB to 60MB (8% decrease) - Total memory in use decreases from 178MiB to 157MiB (12% decrease) hledger reg -f examples/10000x10000x10.journal - Maximum residency decreases from 69MB to 60MB (13% decrease) - Total memory in use decreases from 198MiB to 153MiB (23% decrease) hledger bal -f examples/10000x1000x10.journal - Total heap usage decreases from 6.4GB to 6.0GB (6% decrease) - Total memory in use decreases from 178MiB to 153MiB (14% decrease) hledger bal -f examples/10000x10000x10.journal - Total heap usage decreases from 7.3GB to 6.9GB (5% decrease) - Total memory in use decreases from 196MiB to 185MiB (5% decrease) hledger bal -M -f examples/10000x1000x10.journal - Total heap usage decreases from 16.8GB to 10.6GB (47% decrease) - Total time decreases from 14.3s to 12.0s (16% decrease) hledger bal -M -f examples/10000x10000x10.journal - Total heap usage decreases from 108GB to 48GB (56% decrease) - Total time decreases from 62s to 41s (33% decrease) If you never directly use the constructor Mixed or pattern match against it then you don't need to make any changes. If you do, then do the following: - If you really care about the individual Amounts and never normalise your MixedAmount (for example, just storing `Mixed amts` and then extracting `amts` as a pattern match, then use should switch to using [Amount]. This should just involve removing the `Mixed` constructor. - If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of amount arithmetic (+), (-), then you should replace the constructor `Mixed` with the function `mixed`. To extract the list of Amounts, use the function `amounts`. - If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can replace that with `mixedAmountStripPrices`. (N.B. this does something slightly different from `normaliseMixedAmountSquashPricesForDisplay`, but I don't think there's any use case for squashing prices and then keeping the first of the squashed prices around. If you disagree let me know.) - Any remaining calls to `normaliseMixedAmount` can be removed, as that is now the identity function.
113 lines
4.7 KiB
Haskell
113 lines
4.7 KiB
Haskell
{-|
|
|
|
|
Print some statistics for the journal.
|
|
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Hledger.Cli.Commands.Stats (
|
|
statsmode
|
|
,stats
|
|
)
|
|
where
|
|
|
|
import Data.List
|
|
import Data.List.Extra (nubSort)
|
|
import Data.Maybe
|
|
import Data.Ord
|
|
import Data.HashSet (size, fromList)
|
|
-- import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Data.Time.Calendar
|
|
import System.Console.CmdArgs.Explicit
|
|
import Text.Printf
|
|
import qualified Data.Map as Map
|
|
|
|
import Hledger
|
|
import Hledger.Cli.CliOptions
|
|
import Prelude hiding (putStr)
|
|
import Hledger.Cli.Utils (writeOutput)
|
|
|
|
|
|
statsmode = hledgerCommandMode
|
|
$(embedFileRelative "Hledger/Cli/Commands/Stats.txt")
|
|
[flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE."
|
|
]
|
|
[generalflagsgroup1]
|
|
hiddenflags
|
|
([], Just $ argsFlag "[QUERY]")
|
|
|
|
-- like Register.summarisePostings
|
|
-- | Print various statistics for the journal.
|
|
stats :: CliOpts -> Journal -> IO ()
|
|
stats opts@CliOpts{reportspec_=rspec} j = do
|
|
d <- getCurrentDay
|
|
let q = rsQuery rspec
|
|
l = ledgerFromJournal q j
|
|
reportspan = ledgerDateSpan l `spanDefaultsFrom` queryDateSpan False q
|
|
intervalspans = splitSpan (interval_ $ rsOpts rspec) reportspan
|
|
showstats = showLedgerStats l d
|
|
s = intercalate "\n" $ map showstats intervalspans
|
|
writeOutput opts s
|
|
|
|
showLedgerStats :: Ledger -> Day -> DateSpan -> String
|
|
showLedgerStats l today span =
|
|
unlines $ map (\(label,value) -> concatBottomPadded [printf fmt1 label, value]) stats
|
|
where
|
|
fmt1 = "%-" ++ show w1 ++ "s: "
|
|
-- fmt2 = "%-" ++ show w2 ++ "s"
|
|
w1 = maximum $ map (length . fst) stats
|
|
-- w2 = maximum $ map (length . show . snd) stats
|
|
stats = [
|
|
("Main file" :: String, path) -- ++ " (from " ++ source ++ ")")
|
|
,("Included files", unlines $ drop 1 $ journalFilePaths j)
|
|
,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days)
|
|
,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)
|
|
,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)
|
|
,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)
|
|
,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
|
|
,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts)
|
|
,("Accounts", printf "%d (depth %d)" acctnum acctdepth)
|
|
,("Commodities", printf "%s (%s)" (show $ length cs) (T.intercalate ", " cs))
|
|
,("Market prices", printf "%s (%s)" (show $ length mktprices) (T.intercalate ", " mktpricecommodities))
|
|
-- Transactions this month : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
|
|
-- Unmarked transactions : %(unmarked)s
|
|
-- Days since reconciliation : %(reconcileelapsed)s
|
|
-- Days since last transaction : %(recentelapsed)s
|
|
]
|
|
where
|
|
j = ljournal l
|
|
path = journalFilePath j
|
|
ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j
|
|
as = nub $ map paccount $ concatMap tpostings ts
|
|
cs = either error' Map.keys . commodityStylesFromAmounts . concatMap (amountsRaw . pamount) $ concatMap tpostings ts -- PARTIAL:
|
|
lastdate | null ts = Nothing
|
|
| otherwise = Just $ tdate $ last ts
|
|
lastelapsed = fmap (diffDays today) lastdate
|
|
showelapsed Nothing = ""
|
|
showelapsed (Just days) = printf " (%d %s)" days' direction
|
|
where days' = abs days
|
|
direction | days >= 0 = "days ago" :: String
|
|
| otherwise = "days from now"
|
|
tnum = length ts
|
|
start (DateSpan (Just d) _) = show d
|
|
start _ = ""
|
|
end (DateSpan _ (Just d)) = show d
|
|
end _ = ""
|
|
days = fromMaybe 0 $ daysInSpan span
|
|
txnrate | days==0 = 0
|
|
| otherwise = fromIntegral tnum / fromIntegral days :: Double
|
|
tnum30 = length $ filter withinlast30 ts
|
|
withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t
|
|
txnrate30 = fromIntegral tnum30 / 30 :: Double
|
|
tnum7 = length $ filter withinlast7 ts
|
|
withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t
|
|
txnrate7 = fromIntegral tnum7 / 7 :: Double
|
|
acctnum = length as
|
|
acctdepth | null as = 0
|
|
| otherwise = maximum $ map accountNameLevel as
|
|
mktprices = jpricedirectives j
|
|
mktpricecommodities = nubSort $ map pdcommodity mktprices
|