diff --git a/Hledger/Cli/Commands/Balance.hs b/Hledger/Cli/Commands/Balance.hs index d09019490..d1ca109cc 100644 --- a/Hledger/Cli/Commands/Balance.hs +++ b/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. -showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String -showBalanceReport opts filterspec j = acctsstr ++ totalstr +-- | Render balance report data as plain text suitable for console output. +showBalanceReport :: [Opt] -> BalanceReportData -> String +showBalanceReport opts (items,total) = acctsstr ++ totalstr where - l = journalToLedger filterspec j - 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 + acctsstr = unlines $ map showitem items 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. -showInterestingAccount :: [Opt] -> Ledger -> [AccountName] -> AccountName -> String -showInterestingAccount opts l interestingaccts a = concatTopPadded [amt, " ", name] +-- | Get data for a balance report with the specified options for this journal. +balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReportData +balanceReport opts filterspec j = (items, total) where - amt = padleft 20 $ showMixedAmountWithoutPrice bal - bal | Flat `elem` opts = exclusiveBalance acct - | otherwise = abalance acct - acct = ledgerAccount l a - name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a - | otherwise = depthspacer ++ partialname - parents = parentAccountNames a - interestingparents = filter (`elem` interestingaccts) parents - depthspacer = replicate (indentperlevel * length interestingparents) ' ' - indentperlevel = 2 - -- the partial name is the account's leaf name, prefixed by the - -- names of any boring parents immediately above - partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a] - where ps = takeWhile boring parents where boring = not . (`elem` interestingparents) + items = map mkitem interestingaccts + interestingaccts = filter (isInteresting opts l) acctnames + acctnames = sort $ tail $ flatten $ treemap aname accttree + accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l + total = sum $ map abalance $ ledgerTopAccounts l + l = journalToLedger filterspec j + -- | Get data for one balance report line item. + mkitem :: AccountName -> BalanceReportItem + mkitem a = (a, adisplay, adepth, abal) + where + adisplay = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a] + where ps = takeWhile boring parents where boring = not . (`elem` interestingparents) + adepth = length 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 diff --git a/Hledger/Cli/Commands/Vty.hs b/Hledger/Cli/Commands/Vty.hs index 3921fa2e8..a237c06e4 100644 --- a/Hledger/Cli/Commands/Vty.hs +++ b/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 diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index c1d9f343c..541e058df 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/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 diff --git a/Hledger/Cli/Tests.hs b/Hledger/Cli/Tests.hs index d86405368..6bb971436 100644 --- a/Hledger/Cli/Tests.hs +++ b/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 расходы:покупки" ,"--------------------"