mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib,cli: Some efficiency improvements in register reports.
Strip prices after valuing postings in PostingsReport. Use renderRow interface for Register report. For reg -f examples/10000x10000x10.journal, this results in: - Heap allocations decreasing by 55%, from 68.6GB to 31.2GB - Resident memory decreasing by 75%, from 254GB to 65GB - Total (profiled) time decreasing by 55%, from 37s to 20s
This commit is contained in:
parent
d54e276658
commit
7aa3d3e760
@ -91,10 +91,13 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
|
||||
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
|
||||
reportPeriodOrJournalLastDay rspec j
|
||||
|
||||
-- Posting report does not use prices after valuation, so remove them.
|
||||
displaypsnoprices = map (\(p,md) -> (removePrices p, md)) displayps
|
||||
|
||||
-- Posting report items ready for display.
|
||||
items =
|
||||
dbg4 "postingsReport items" $
|
||||
postingsReportItems displayps (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum
|
||||
postingsReportItems displaypsnoprices (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum
|
||||
where
|
||||
-- In historical mode we'll need a starting balance, which we
|
||||
-- may be converting to value per hledger_options.m4.md "Effect
|
||||
|
@ -18,7 +18,7 @@ module Hledger.Cli.Commands.Register (
|
||||
,tests_Register
|
||||
) where
|
||||
|
||||
import Data.List (intersperse)
|
||||
import Data.Default (def)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
@ -27,12 +27,14 @@ import Data.Semigroup ((<>))
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import System.Console.CmdArgs.Explicit (flagNone, flagReq)
|
||||
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Cli.Utils
|
||||
import Text.Tabular (Header(..), Properties(..))
|
||||
import Text.Tabular.AsciiWide
|
||||
|
||||
registermode = hledgerCommandMode
|
||||
$(embedFileRelative "Hledger/Cli/Commands/Register.txt")
|
||||
@ -129,22 +131,21 @@ postingsReportAsText opts items =
|
||||
--
|
||||
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Builder
|
||||
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
|
||||
-- use elide*Width to be wide-char-aware
|
||||
-- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
|
||||
foldMap TB.fromText . concat . intersperse (["\n"]) $
|
||||
[ fitText (Just datewidth) (Just datewidth) True True date
|
||||
, " "
|
||||
, fitText (Just descwidth) (Just descwidth) True True desc
|
||||
, " "
|
||||
, fitText (Just acctwidth) (Just acctwidth) True True acct
|
||||
, " "
|
||||
, amtfirstline
|
||||
, " "
|
||||
, balfirstline
|
||||
]
|
||||
:
|
||||
[ [ spacer, a, " ", b ] | (a,b) <- zip amtrest balrest ]
|
||||
render
|
||||
[ textCell TopLeft $ fitText (Just datewidth) (Just datewidth) True True date
|
||||
, spacerCell
|
||||
, textCell TopLeft $ fitText (Just descwidth) (Just descwidth) True True desc
|
||||
, spacerCell2
|
||||
, textCell TopLeft $ fitText (Just acctwidth) (Just acctwidth) True True acct
|
||||
, spacerCell2
|
||||
, Cell TopRight amt
|
||||
, spacerCell2
|
||||
, Cell BottomRight bal
|
||||
]
|
||||
where
|
||||
render = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header
|
||||
spacerCell = Cell BottomLeft [WideBuilder (TB.singleton ' ') 1]
|
||||
spacerCell2 = Cell BottomLeft [WideBuilder (TB.fromString " ") 2]
|
||||
-- calculate widths
|
||||
(totalwidth,mdescwidth) = registerWidthsFromOpts opts
|
||||
(datewidth, date) = case (mdate,menddate) of
|
||||
@ -181,18 +182,9 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
|
||||
VirtualPosting -> (\s -> wrap "(" ")" s, acctwidth-2)
|
||||
_ -> (id,acctwidth)
|
||||
wrap a b x = a <> x <> b
|
||||
amt = TL.toStrict . TB.toLazyText . wbBuilder . showamt amtwidth $ pamount p
|
||||
bal = TL.toStrict . TB.toLazyText . wbBuilder $ showamt balwidth b
|
||||
showamt w = showMixedAmountB noPrice{displayColour=color_ . rsOpts $ reportspec_ opts, displayMinWidth=Just w, displayMaxWidth=Just w}
|
||||
-- alternate behaviour, show null amounts as 0 instead of blank
|
||||
-- amt = if null amt' then "0" else amt'
|
||||
-- bal = if null bal' then "0" else bal'
|
||||
(amtlines, ballines) = (T.lines amt, T.lines bal)
|
||||
(amtlen, ballen) = (length amtlines, length ballines)
|
||||
numlines = max 1 (max amtlen ballen)
|
||||
(amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (T.replicate amtwidth " ") -- posting amount is top-aligned
|
||||
(balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (T.replicate balwidth " ") ++ ballines -- balance amount is bottom-aligned
|
||||
spacer = T.replicate (totalwidth - (amtwidth + 2 + balwidth)) " "
|
||||
amt = showAmountsLinesB (dopts amtwidth) . (\x -> if null x then [nullamt] else x) . amounts $ pamount p
|
||||
bal = showAmountsLinesB (dopts balwidth) $ amounts b
|
||||
dopts w = noPrice{displayColour=color_ . rsOpts $ reportspec_ opts, displayMinWidth=Just w, displayMaxWidth=Just w}
|
||||
|
||||
-- tests
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user