214 lines
		
	
	
		
			7.7 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			214 lines
		
	
	
		
			7.7 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {-# LANGUAGE CPP #-}
 | |
| {-|
 | |
| 
 | |
| A ledger-compatible @balance@ command.
 | |
| 
 | |
| ledger's balance command is easy to use but not easy to describe
 | |
| precisely.  In the examples below we'll use sample.journal, which has the
 | |
| following account tree:
 | |
| 
 | |
| @
 | |
|  assets
 | |
|    bank
 | |
|      checking
 | |
|      saving
 | |
|    cash
 | |
|  expenses
 | |
|    food
 | |
|    supplies
 | |
|  income
 | |
|    gifts
 | |
|    salary
 | |
|  liabilities
 | |
|    debts
 | |
| @
 | |
| 
 | |
| The balance command shows accounts with their aggregate balances.
 | |
| Subaccounts are displayed indented below their parent. Each balance is the
 | |
| sum of any transactions in that account plus any balances from
 | |
| subaccounts:
 | |
| 
 | |
| @
 | |
|  $ hledger -f sample.journal balance
 | |
|                  $-1  assets
 | |
|                   $1    bank:saving
 | |
|                  $-2    cash
 | |
|                   $2  expenses
 | |
|                   $1    food
 | |
|                   $1    supplies
 | |
|                  $-2  income
 | |
|                  $-1    gifts
 | |
|                  $-1    salary
 | |
|                   $1  liabilities:debts
 | |
| @
 | |
| 
 | |
| Usually, the non-interesting accounts are elided or omitted. Above,
 | |
| @checking@ is omitted because it has no subaccounts and a zero balance.
 | |
| @bank@ is elided because it has only a single displayed subaccount
 | |
| (@saving@) and it would be showing the same balance as that ($1). Ditto
 | |
| for @liabilities@. We will return to this in a moment.
 | |
| 
 | |
| The --depth argument can be used to limit the depth of the balance report.
 | |
| So, to see just the top level accounts:
 | |
| 
 | |
| @
 | |
| $ hledger -f sample.journal balance --depth 1
 | |
|                  $-1  assets
 | |
|                   $2  expenses
 | |
|                  $-2  income
 | |
|                   $1  liabilities
 | |
| @
 | |
| 
 | |
| This time liabilities has no displayed subaccounts (due to --depth) and
 | |
| is not elided.
 | |
| 
 | |
| With one or more account pattern arguments, the balance command shows
 | |
| accounts whose name matches one of the patterns, plus their parents
 | |
| (elided) and subaccounts. So with the pattern o we get:
 | |
| 
 | |
| @
 | |
|  $ hledger -f sample.journal balance o
 | |
|                   $1  expenses:food
 | |
|                  $-2  income
 | |
|                  $-1    gifts
 | |
|                  $-1    salary
 | |
| --------------------
 | |
|                  $-1
 | |
| @
 | |
| 
 | |
| The o pattern matched @food@ and @income@, so they are shown. Unmatched
 | |
| parents of matched accounts are also shown (elided) for context (@expenses@).
 | |
| 
 | |
| Also, the balance report shows the total of all displayed accounts, when
 | |
| that is non-zero. Here, it is displayed because the accounts shown add up
 | |
| to $-1.
 | |
| 
 | |
| Here is a more precise definition of \"interesting\" accounts in ledger's
 | |
| balance report:
 | |
| 
 | |
| - an account which has just one interesting subaccount branch, and which
 | |
|   is not at the report's maximum depth, is interesting if the balance is
 | |
|   different from the subaccount's, and otherwise boring.
 | |
| 
 | |
| - any other account is interesting if it has a non-zero balance, or the -E
 | |
|   flag is used.
 | |
| 
 | |
| -}
 | |
| 
 | |
| module Hledger.Cli.Commands.Balance (
 | |
|   BalanceReport
 | |
|  ,BalanceReportItem
 | |
|  ,balance
 | |
|  ,balanceReport
 | |
|  ,balanceReportAsText
 | |
|  -- ,tests_Balance
 | |
| ) where
 | |
| import Hledger.Data.Utils
 | |
| import Hledger.Data.Types
 | |
| import Hledger.Data.Amount
 | |
| import Hledger.Data.AccountName
 | |
| import Hledger.Data.Posting
 | |
| import Hledger.Data.Ledger
 | |
| import Hledger.Cli.Options
 | |
| #if __GLASGOW_HASKELL__ <= 610
 | |
| import Prelude hiding ( putStr )
 | |
| import System.IO.UTF8
 | |
| #endif
 | |
| 
 | |
| 
 | |
| -- | A balance report is a chart of accounts with balances, and their grand total.
 | |
| type BalanceReport = ([BalanceReportItem] -- ^ line items, one per account
 | |
|                      ,MixedAmount         -- ^ total balance of all accounts
 | |
|                      )
 | |
| 
 | |
| -- | The data for a single balance report line item, representing one account.
 | |
| 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 $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args t) j
 | |
| 
 | |
| -- | Render a balance report as plain text suitable for console output.
 | |
| balanceReportAsText :: [Opt] -> BalanceReport -> String
 | |
| balanceReportAsText opts (items,total) =
 | |
|     unlines $
 | |
|             map (balanceReportItemAsText opts) items
 | |
|             ++
 | |
|             if NoTotal `elem` opts
 | |
|              then []
 | |
|              else ["--------------------"
 | |
|                   ,padleft 20 $ showMixedAmountWithoutPrice total
 | |
|                   ]
 | |
| 
 | |
| -- | Render one balance report line item as plain text.
 | |
| balanceReportItemAsText :: [Opt] -> BalanceReportItem -> String
 | |
| balanceReportItemAsText opts (a, adisplay, adepth, abal) = concatTopPadded [amt, "  ", name]
 | |
|     where
 | |
|       amt = padleft 20 $ showMixedAmountWithoutPrice abal
 | |
|       name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a
 | |
|            | otherwise        = depthspacer ++ adisplay
 | |
|       depthspacer = replicate (indentperlevel * adepth) ' '
 | |
|       indentperlevel = 2
 | |
| 
 | |
| -- | Get a balance report with the specified options for this journal.
 | |
| balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReport
 | |
| balanceReport opts filterspec j = (items, total)
 | |
|     where
 | |
|       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, indent, abal)
 | |
|           where
 | |
|             adisplay | Flat `elem` opts = a
 | |
|                      | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
 | |
|                 where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
 | |
|             indent | Flat `elem` opts = 0
 | |
|                    | otherwise = 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
 | |
| 
 | |
| -- | Is the named account considered interesting for this ledger's balance report ?
 | |
| isInteresting :: [Opt] -> Ledger -> AccountName -> Bool
 | |
| isInteresting opts l a | Flat `elem` opts = isInterestingFlat opts l a
 | |
|                        | otherwise = isInterestingIndented opts l a
 | |
| 
 | |
| isInterestingFlat :: [Opt] -> Ledger -> AccountName -> Bool
 | |
| isInterestingFlat opts l a = notempty || emptyflag
 | |
|     where
 | |
|       acct = ledgerAccount l a
 | |
|       notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
 | |
|       emptyflag = Empty `elem` opts
 | |
| 
 | |
| isInterestingIndented :: [Opt] -> Ledger -> AccountName -> Bool
 | |
| isInterestingIndented opts l a
 | |
|     | numinterestingsubs==1 && not atmaxdepth = notlikesub
 | |
|     | otherwise = notzero || emptyflag
 | |
|     where
 | |
|       atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts
 | |
|       emptyflag = Empty `elem` opts
 | |
|       acct = ledgerAccount l a
 | |
|       notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
 | |
|       notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
 | |
|       numinterestingsubs = length $ filter isInterestingTree subtrees
 | |
|           where
 | |
|             isInterestingTree = treeany (isInteresting opts l . aname)
 | |
|             subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a
 | |
| 
 |