dev: reg: areg: Be more clever about register and aregister alignment.

When rendering register or aregister reports, calculate the amount /
balance width based on the first 100 items, and start rendering in that
way. If you encounter a longer one, update and continue rendering. This
will result in adjustment of column width for long reports, but allows
us to save a lot more performant/efficient.

This can be disabled with the new --align-all flag.

We also only render each amount once, rather than twice as before, by
storing the rendered amount in a tuple.
This commit is contained in:
Stephen Morgan 2022-03-11 17:26:10 +11:00 committed by Simon Michael
parent cbc985d411
commit c0cc9e73c1
3 changed files with 47 additions and 21 deletions

View File

@ -56,6 +56,7 @@ aregistermode = hledgerCommandMode
#endif #endif
++ " or $COLUMNS). -wN,M sets description width as well." ++ " or $COLUMNS). -wN,M sets description width as well."
) )
,flagNone ["align-all"] (setboolopt "align-all") "truly align to the longest widths"
,outputFormatFlag ["txt","csv","json"] ,outputFormatFlag ["txt","csv","json"]
,outputFileFlag ,outputFileFlag
]) ])
@ -127,12 +128,11 @@ accountTransactionsReportItemAsCsvRecord
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
accountTransactionsReportAsText copts reportq thisacctq items = TB.toLazyText $ accountTransactionsReportAsText copts reportq thisacctq items = TB.toLazyText $
title <> TB.singleton '\n' <> lines title <> TB.singleton '\n' <>
postingsOrTransactionsReportAsText alignAll copts itemAsText itemamt itembal items
where where
lines = foldMap (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items alignAll = boolopt "align-all" $ rawopts_ copts
amtwidth = maximumStrict $ 12 : widths (map itemamt $ take 1000 items) itemAsText = accountTransactionsReportItemAsText copts reportq thisacctq
balwidth = maximumStrict $ 12 : widths (map itembal $ take 1000 items)
widths = map wbWidth . concatMap (showMixedAmountLinesB oneLine)
itemamt (_,_,_,_,a,_) = a itemamt (_,_,_,_,a,_) = a
itembal (_,_,_,_,_,a) = a itembal (_,_,_,_,_,a) = a
@ -156,11 +156,13 @@ accountTransactionsReportAsText copts reportq thisacctq items = TB.toLazyText $
-- Returns a string which can be multi-line, eg if the running balance -- Returns a string which can be multi-line, eg if the running balance
-- has multiple commodities. -- has multiple commodities.
-- --
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> TB.Builder accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int
-> (AccountTransactionsReportItem, [WideBuilder], [WideBuilder])
-> TB.Builder
accountTransactionsReportItemAsText accountTransactionsReportItemAsText
copts@CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts@ReportOpts{color_}}} copts@CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}}
reportq thisacctq preferredamtwidth preferredbalwidth reportq thisacctq preferredamtwidth preferredbalwidth
(t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance) = ((t@Transaction{tdescription}, _, _issplit, otheracctsstr, _, _), amt, bal) =
-- Transaction -- the transaction, unmodified -- Transaction -- the transaction, unmodified
-- Transaction -- the transaction, as seen from the current account -- Transaction -- the transaction, as seen from the current account
-- Bool -- is this a split (more than one posting to other accounts) ? -- Bool -- is this a split (more than one posting to other accounts) ?
@ -206,9 +208,6 @@ accountTransactionsReportItemAsText
-- gather content -- gather content
accts = -- T.unpack $ elideAccountName acctwidth $ T.pack accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
otheracctsstr otheracctsstr
amt = showamt change
bal = showamt balance
showamt = showMixedAmountLinesB noPrice{displayColour=color_}
-- tests -- tests

View File

@ -50,6 +50,7 @@ registermode = hledgerCommandMode
#endif #endif
++ " or $COLUMNS). -wN,M sets description width as well." ++ " or $COLUMNS). -wN,M sets description width as well."
) )
,flagNone ["align-all"] (setboolopt "align-all") "truly align to the longest widths"
,outputFormatFlag ["txt","csv","json"] ,outputFormatFlag ["txt","csv","json"]
,outputFileFlag ,outputFileFlag
]) ])
@ -93,12 +94,10 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
postingsReportAsText opts items = TB.toLazyText lines postingsReportAsText opts = TB.toLazyText .
postingsOrTransactionsReportAsText alignAll opts (postingsReportItemAsText opts) itemamt itembal
where where
lines = foldMap (postingsReportItemAsText opts amtwidth balwidth) items alignAll = boolopt "align-all" $ rawopts_ opts
amtwidth = maximumStrict $ 12 : widths (map itemamt $ take 1000 items)
balwidth = maximumStrict $ 12 : widths (map itembal $ take 1000 items)
widths = map wbWidth . concatMap (showMixedAmountLinesB oneLine)
itemamt (_,_,_,Posting{pamount=a},_) = a itemamt (_,_,_,Posting{pamount=a},_) = a
itembal (_,_,_,_,a) = a itembal (_,_,_,_,a) = a
@ -126,8 +125,10 @@ postingsReportAsText opts items = TB.toLazyText lines
-- --
-- Also returns the natural width (without padding) of the amount and balance -- Also returns the natural width (without padding) of the amount and balance
-- fields. -- fields.
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Builder postingsReportItemAsText :: CliOpts -> Int -> Int
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mperiod, mdesc, p, b) = -> (PostingsReportItem, [WideBuilder], [WideBuilder])
-> TB.Builder
postingsReportItemAsText opts preferredamtwidth preferredbalwidth ((mdate, mperiod, mdesc, p, _), amt, bal) =
table <> TB.singleton '\n' table <> TB.singleton '\n'
where where
table = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header table = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header
@ -177,9 +178,6 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mperio
BalancedVirtualPosting -> (wrap "[" "]", acctwidth-2) BalancedVirtualPosting -> (wrap "[" "]", acctwidth-2)
VirtualPosting -> (wrap "(" ")", acctwidth-2) VirtualPosting -> (wrap "(" ")", acctwidth-2)
_ -> (id,acctwidth) _ -> (id,acctwidth)
amt = showamt $ pamount p
bal = showamt b
showamt = showMixedAmountLinesB oneLine{displayColour=color_ . _rsReportOpts $ reportspec_ opts}
-- tests -- tests

View File

@ -25,6 +25,7 @@ module Hledger.Cli.Utils
pivotByOpts, pivotByOpts,
anonymiseByOpts, anonymiseByOpts,
journalSimilarTransaction, journalSimilarTransaction,
postingsOrTransactionsReportAsText,
tests_Cli_Utils, tests_Cli_Utils,
) )
where where
@ -35,9 +36,11 @@ import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.IO as TL import qualified Data.Text.Lazy.IO as TL
import Data.Time (Day) import Data.Time (Day)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Lens.Micro ((^.))
import Safe (readMay, headMay) import Safe (readMay, headMay)
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Directory (getModificationTime, getDirectoryContents, copyFile, doesFileExist) import System.Directory (getModificationTime, getDirectoryContents, copyFile, doesFileExist)
@ -256,6 +259,32 @@ journalSimilarTransaction cliopts j desc = mbestmatch
journalTransactionsSimilarTo j q desc 10 journalTransactionsSimilarTo j q desc 10
q = queryFromFlags $ _rsReportOpts $ reportspec_ cliopts q = queryFromFlags $ _rsReportOpts $ reportspec_ cliopts
-- | Render a 'PostingsReport' or 'AccountTransactionsReport' as Text,
-- determining the appropriate starting widths and increasing as necessary.
postingsOrTransactionsReportAsText
:: Bool -> CliOpts -> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> TB.Builder)
-> (a -> MixedAmount) -> (a -> MixedAmount) -> [a] -> TB.Builder
postingsOrTransactionsReportAsText alignAll opts itemAsText itemamt itembal report =
mconcat . snd $ mapAccumL renderItem (startWidth amt, startWidth bal) itemsWithAmounts
where
minWidth = 12
chunkSize = 100
renderItem (amtWidth, balWidth) item@(_, amt, bal) = ((amtWidth', balWidth'), itemBuilder)
where
itemBuilder = itemAsText amtWidth' balWidth' item
amtWidth' = if alignAll then amtWidth else maximumStrict $ amtWidth : map wbWidth amt
balWidth' = if alignAll then balWidth else maximumStrict $ balWidth : map wbWidth bal
startWidth f = maximum $ minWidth : map wbWidth (concatMap f startAlign)
where
startAlign = (if alignAll then id else take chunkSize) itemsWithAmounts
itemsWithAmounts = map (\x -> (x, showAmt $ itemamt x, showAmt $ itembal x)) report
showAmt = showMixedAmountLinesB oneLine{displayColour=opts^.color__}
amt = second3
bal = third3
tests_Cli_Utils = testGroup "Utils" [ tests_Cli_Utils = testGroup "Utils" [
-- testGroup "journalApplyValue" [ -- testGroup "journalApplyValue" [