refactor: split showBalanceReport into reusable-data-generating and rendering steps

Hledger/Cli/Commands/Balance.hs

@@ -110,46 +110,57 @@ import System.IO.UTF8
 #endif
 
 
+type BalanceReportData = ([BalanceReportItem]
+                         ,MixedAmount  -- ^ total balance of all accounts
+                         )
+
+type BalanceReportItem = (AccountName  -- ^ full account name
+                         ,AccountName  -- ^ account name elided for display: the leaf name,
+                                       --   prefixed by any boring parents immediately above
+                         ,Int          -- ^ account depth within this report, excludes boring parents
+                         ,MixedAmount) -- ^ account balance, includes subs unless --flat is present
+
 -- | Print a balance report.
 balance :: [Opt] -> [String] -> Journal -> IO ()
 balance opts args j = do
   t <- getCurrentLocalTime
-  putStr $ showBalanceReport opts (optsToFilterSpec opts args t) j
+  putStr $ showBalanceReport opts $ balanceReport opts (optsToFilterSpec opts args t) j
 
--- | Generate a balance report with the specified options for this journal.
+-- | Render balance report data as plain text suitable for console output.
-showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String
+showBalanceReport :: [Opt] -> BalanceReportData -> String
-showBalanceReport opts filterspec j = acctsstr ++ totalstr
+showBalanceReport opts (items,total) = acctsstr ++ totalstr
     where
-      l = journalToLedger filterspec j
+      acctsstr = unlines $ map showitem items
-      acctsstr = unlines $ map showacct interestingaccts
-          where
-            showacct = showInterestingAccount opts l interestingaccts
-            interestingaccts = filter (isInteresting opts l) acctnames
-            acctnames = sort $ tail $ flatten $ treemap aname accttree
-            accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
       totalstr | NoTotal `elem` opts = ""
                | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total
+      -- | Render one balance report line item as plain text.
+      showitem :: BalanceReportItem -> String
+      showitem (a, adisplay, adepth, abal) = concatTopPadded [amt, "  ", name]
           where
             total = sum $ map abalance $ ledgerTopAccounts l
 
--- | Display one line of the balance report with appropriate indenting and eliding.
+-- | Get data for a balance report with the specified options for this journal.
-showInterestingAccount :: [Opt] -> Ledger -> [AccountName] -> AccountName -> String
+balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReportData
-showInterestingAccount opts l interestingaccts a = concatTopPadded [amt, "  ", name]
+balanceReport opts filterspec j = (items, total)
     where
-      amt = padleft 20 $ showMixedAmountWithoutPrice bal
+      items = map mkitem interestingaccts
-      bal | Flat `elem` opts = exclusiveBalance acct
+      interestingaccts = filter (isInteresting opts l) acctnames
-          | otherwise = abalance acct
+      acctnames = sort $ tail $ flatten $ treemap aname accttree
-      acct = ledgerAccount l a
+      accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
-      name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a
+      total = sum $ map abalance $ ledgerTopAccounts l
-           | otherwise        = depthspacer ++ partialname
+      l = journalToLedger filterspec j
-      parents = parentAccountNames a
+      -- | Get data for one balance report line item.
-      interestingparents = filter (`elem` interestingaccts) parents
+      mkitem :: AccountName -> BalanceReportItem
-      depthspacer = replicate (indentperlevel * length interestingparents) ' '
+      mkitem a = (a, adisplay, adepth, abal)
-      indentperlevel = 2
+          where
-      -- the partial name is the account's leaf name, prefixed by the
+            adisplay = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
-      -- names of any boring parents immediately above
+                where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
-      partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
+            adepth = length interestingparents
-          where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
+            interestingparents = filter (`elem` interestingaccts) parents
+            parents = parentAccountNames a
+            abal | Flat `elem` opts = exclusiveBalance acct
+                 | otherwise = abalance acct
+                 where acct = ledgerAccount l a
 
 exclusiveBalance :: Account -> MixedAmount
 exclusiveBalance = sumPostings . apostings

Hledger/Cli/Commands/Vty.hs

@@ -229,7 +229,7 @@ resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a
 updateData :: LocalTime -> AppState -> AppState
 updateData t a@AppState{aopts=opts,ajournal=j} =
     case screen a of
-      BalanceScreen  -> a{abuf=lines $ showBalanceReport opts fspec j}
+      BalanceScreen  -> a{abuf=lines $ showBalanceReport opts $ balanceReport opts fspec j}
       RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j}
       PrintScreen    -> a{abuf=lines $ showTransactions fspec j}
     where fspec = optsToFilterSpec opts (currentArgs a) t

Hledger/Cli/Commands/Web.hs

@@ -100,7 +100,8 @@ getRegisterPage :: Handler HledgerWebApp RepHtml
 getRegisterPage = withLatestJournalRender showRegisterReport
 
 getBalancePage :: Handler HledgerWebApp RepHtml
-getBalancePage = withLatestJournalRender showBalanceReport
+getBalancePage = withLatestJournalRender render
+    where render opts filterspec j = showBalanceReport opts $ balanceReport opts filterspec j
 
 withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml
 withLatestJournalRender reportfn = do

Hledger/Cli/Tests.hs

@@ -109,7 +109,7 @@ tests = TestList [
    let (opts,args) `gives` es = do 
         l <- samplejournalwithopts opts args
         t <- getCurrentLocalTime
-        showBalanceReport opts (optsToFilterSpec opts args t) l `is` unlines es
+        showBalanceReport opts (balanceReport opts (optsToFilterSpec opts args t) l) `is` unlines es
    in TestList
    [
 
@@ -245,7 +245,7 @@ tests = TestList [
              ,"  c:d                   "
              ]) >>= either error return
       let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
-      showBalanceReport [] nullfilterspec j' `is`
+      showBalanceReport [] (balanceReport [] nullfilterspec j') `is`
        unlines
         ["                $500  a:b"
         ,"               $-500  c:d"
@@ -260,7 +260,7 @@ tests = TestList [
               ,"  test:a  1"
               ,"  test:b"
               ])
-      showBalanceReport [] nullfilterspec l `is`
+      showBalanceReport [] (balanceReport [] nullfilterspec l) `is`
        unlines
         ["                   1  test:a"
         ,"                  -1  test:b"
@@ -586,7 +586,7 @@ tests = TestList [
   ,"unicode in balance layout" ~: do
     l <- readJournalWithOpts []
       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-    showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines
+    showBalanceReport [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines
       ["                -100  актив:наличные"
       ,"                 100  расходы:покупки"
       ,"--------------------"