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:
		
							parent
							
								
									cbc985d411
								
							
						
					
					
						commit
						c0cc9e73c1
					
				| @ -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 | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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" [ | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user