lib: Do not call showAmount twice for every posting.

For print -f examples/10000x10000x10.journal, this results in
- A 7.7% reduction in heap allocations, from 7.6GB to 7.1GB.

hledger-lib/Hledger/Data/Transaction.hs

@@ -75,6 +75,7 @@ import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
 import Data.Time.Calendar (Day, fromGregorian)
 import qualified Data.Map as M
+import Safe (maximumDef)
 
 import Hledger.Utils
 import Hledger.Data.Types
@@ -218,9 +219,12 @@ renderCommentLines t =
 --
 -- Posting amounts will be aligned with each other, starting about 4 columns
 -- beyond the widest account name (see postingAsLines for details).
---
 postingsAsLines :: Bool -> [Posting] -> [Text]
-postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamounts ps) ps
+postingsAsLines onelineamounts ps = concatMap first3 linesWithWidths
+  where
+    linesWithWidths = map (postingAsLines False onelineamounts maxacctwidth maxamtwidth) ps
+    maxacctwidth = maximumDef 0 $ map second3 linesWithWidths
+    maxamtwidth  = maximumDef 0 $ map third3 linesWithWidths
 
 -- | Render one posting, on one or more lines, suitable for `print` output.
 -- There will be an indented account name, plus one or more of status flag,
@@ -241,9 +245,10 @@ postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamoun
 -- increased if needed to match the posting with the longest account name.
 -- This is used to align the amounts of a transaction's postings.
 --
-postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [Text]
+-- Also returns the account width and amount width used.
-postingAsLines elideamount onelineamounts pstoalignwith p =
+postingAsLines :: Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
-    concatMap (++ newlinecomments) postingblocks
+postingAsLines elideamount onelineamounts acctwidth amtwidth p =
+    (concatMap (++ newlinecomments) postingblocks, thisacctwidth, thisamtwidth)
   where
     -- This needs to be converted to strict Text in order to strip trailing
     -- spaces. This adds a small amount of inefficiency, and the only difference
@@ -253,30 +258,35 @@ postingAsLines elideamount onelineamounts pstoalignwith p =
     postingblocks = [map T.stripEnd . T.lines . TL.toStrict $
                        render [ textCell BottomLeft statusandaccount
                               , textCell BottomLeft "  "
-                              , Cell BottomLeft [amt]
+                              , Cell BottomLeft [pad amt]
                               , Cell BottomLeft [assertion]
                               , textCell BottomLeft samelinecomment
                               ]
                     | amt <- shownAmounts]
     render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header
+    pad amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt
+      where w = max 12 amtwidth - wbWidth amt  -- min. 12 for backwards compatibility
+
     assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p
-    statusandaccount = lineIndent . fitText (Just $ minwidth) Nothing False True $ pstatusandacct p
-      where
     -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
-        minwidth = maximum $ map ((2+) . textWidth . pacctstr) pstoalignwith
+    statusandaccount = lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p
+    thisacctwidth = textWidth $ pacctstr p
+
+    pacctstr p' = showAccountName Nothing (ptype p') (paccount p')
     pstatusandacct p' = pstatusprefix p' <> pacctstr p'
     pstatusprefix p' = case pstatus p' of
         Unmarked -> ""
         s        -> T.pack (show s) <> " "
-        pacctstr p' = showAccountName Nothing (ptype p') (paccount p')
 
     -- currently prices are considered part of the amount string when right-aligning amounts
+    -- Since we will usually be calling this function with the knot tied between
+    -- amtwidth and thisamtwidth, make sure thisamtwidth does not depend on
+    -- amtwidth at all.
     shownAmounts
       | elideamount || null (amounts $ pamount p) = [mempty]
       | otherwise = showAmountsLinesB displayopts . amounts $ pamount p
-      where
+      where displayopts = noColour{displayOneLine=onelineamounts}
-        displayopts = noColour{displayOneLine=onelineamounts, displayMinWidth = Just amtwidth}
+    thisamtwidth = maximumDef 0 $ map wbWidth shownAmounts
-        amtwidth = maximum $ 12 : map (wbWidth . showAmountsB displayopts{displayMinWidth=Nothing} . amounts . pamount) pstoalignwith  -- min. 12 for backwards compatibility
 
     (samelinecomment, newlinecomments) =
       case renderCommentLines (pcomment p) of []   -> ("",[])
@@ -306,9 +316,11 @@ showBalanceAssertion BalanceAssertion{..} =
 -- | Render a posting, at the appropriate width for aligning with
 -- its siblings if any. Used by the rewrite command.
 showPostingLines :: Posting -> [Text]
-showPostingLines p = postingAsLines False False ps p where
+showPostingLines p = first3 $ postingAsLines False False maxacctwidth maxamtwidth p
-    ps | Just t <- ptransaction p = tpostings t
+  where
-       | otherwise = [p]
+    linesWithWidths = map (postingAsLines False False maxacctwidth maxamtwidth) . maybe [p] tpostings $ ptransaction p
+    maxacctwidth = maximumDef 0 $ map second3 linesWithWidths
+    maxamtwidth  = maximumDef 0 $ map third3 linesWithWidths
 
 -- | Prepend a suitable indent for a posting (or transaction/posting comment) line.
 lineIndent :: Text -> Text
@@ -642,8 +654,8 @@ tests_Transaction :: TestTree
 tests_Transaction =
   tests "Transaction" [
 
-      tests "postingAsLines" [
+      tests "showPostingLines" [
-          test "null posting" $ postingAsLines False False [posting] posting @?= [""]
+          test "null posting" $ showPostingLines posting @?= [""]
         , test "non-null posting" $
            let p =
                 posting
@@ -654,7 +666,7 @@ tests_Transaction =
                   , ptype = RegularPosting
                   , ptags = [("ptag1", "val1"), ("ptag2", "val2")]
                   }
-           in postingAsLines False False [p] p @?=
+           in showPostingLines p @?=
               [ "    * a         $1.00  ; pcomment1"
               , "    ; pcomment2"
               , "    ;   tag3: val3  "

hledger/Hledger/Cli/Commands/Register.hs

@@ -28,9 +28,10 @@ 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 (flagNone, flagReq)
-import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
+import Safe (maximumDef)
 
 import Hledger
+import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
 import Hledger.Cli.CliOptions
 import Hledger.Cli.Utils
 import Text.Tabular (Header(..), Properties(..))
@@ -97,15 +98,18 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal
 
 -- | Render a register report as plain text suitable for console output.
 postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
-postingsReportAsText opts items =
+postingsReportAsText opts items = TB.toLazyText $ foldMap first3 linesWithWidths
-    TB.toLazyText . unlinesB $
-      map (postingsReportItemAsText opts amtwidth balwidth) items
   where
-    amtwidth = maximumStrict $ map (wbWidth . showAmt . itemamt) items
+    linesWithWidths = map (postingsReportItemAsText opts amtwidth balwidth) items
-    balwidth = maximumStrict $ map (wbWidth . showAmt . itembal) items
+    -- Tying this knot seems like it will save work, but ends up creating a big
-    itemamt (_,_,_,Posting{pamount=a},_) = a
+    -- space leak. Can we fix that leak without recalculating everything?
-    itembal (_,_,_,_,a) = a
+    -- amtwidth = maximum $ 12 : map second3 linesWithWidths
-    showAmt = showMixedAmountB noColour{displayMinWidth=Just 12}
+    -- balwidth = maximum $ 12 : map third3 linesWithWidths
+    amtwidth = maximumStrict $ 12 : widths (map itemamt items)
+    balwidth = maximumStrict $ 12 : widths (map itembal items)
+    widths = map wbWidth . concatMap (showAmountsLinesB noPrice)
+    itemamt (_,_,_,Posting{pamount=a},_) = amounts a
+    itembal (_,_,_,_,a) = amounts a
 
 -- | Render one register report line item as plain text. Layout is like so:
 -- @
@@ -129,23 +133,27 @@ postingsReportAsText opts items =
 -- has multiple commodities. Does not yet support formatting control
 -- like balance reports.
 --
-postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Builder
+-- Also returns the natural width (without padding) of the amount and balance
+-- fields.
+postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> (TB.Builder, Int, Int)
 postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
-    render
+    (table <> TB.singleton '\n', thisamtwidth, thisbalwidth)
+  where
+    table = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header
       [ 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
+      , Cell TopRight $ map (pad amtwidth) amt
       , spacerCell2
-      , Cell BottomRight bal
+      , Cell BottomRight $ map (pad balwidth) 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]
+    pad fullwidth amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt
+      where w = fullwidth - wbWidth amt
     -- calculate widths
     (totalwidth,mdescwidth) = registerWidthsFromOpts opts
     (datewidth, date) = case (mdate,menddate) of
@@ -176,15 +184,17 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
     desc = fromMaybe "" mdesc
     acct = parenthesise . elideAccountName awidth $ paccount p
       where
-          (parenthesise, awidth) =
+        (parenthesise, awidth) = case ptype p of
-            case ptype p of
+            BalancedVirtualPosting -> (wrap "[" "]", acctwidth-2)
-              BalancedVirtualPosting -> (\s -> wrap "[" "]" s, acctwidth-2)
+            VirtualPosting         -> (wrap "(" ")", acctwidth-2)
-              VirtualPosting         -> (\s -> wrap "(" ")" s, acctwidth-2)
             _                      -> (id,acctwidth)
-          wrap a b x = a <> x <> b
+    amt = showAmountsLinesB dopts . (\x -> if null x then [nullamt] else x) . amounts $ pamount p
-      amt = showAmountsLinesB (dopts amtwidth) . (\x -> if null x then [nullamt] else x) . amounts $ pamount p
+    bal = showAmountsLinesB dopts $ amounts b
-      bal = showAmountsLinesB (dopts balwidth) $ amounts b
+    dopts = noPrice{displayColour=color_ . rsOpts $ reportspec_ opts}
-      dopts w = noPrice{displayColour=color_ . rsOpts $ reportspec_ opts, displayMinWidth=Just w, displayMaxWidth=Just w}
+    -- Since this will usually be called with the knot tied between this(amt|bal)width and
+    -- preferred(amt|bal)width, make sure the former do not depend on the latter to avoid loops.
+    thisamtwidth = maximumDef 0 $ map wbWidth amt
+    thisbalwidth = maximumDef 0 $ map wbWidth bal
 
 -- tests