module Hledger.Cli.Commands.Balance (
BalanceReport
,BalanceReportItem
,balance
,balanceReport
,balanceReportAsText
) 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
type BalanceReport = ([BalanceReportItem]
,MixedAmount
)
type BalanceReportItem = (AccountName
,AccountName
,Int
,MixedAmount)
balance :: [Opt] -> [String] -> Journal -> IO ()
balance opts args j = do
t <- getCurrentLocalTime
putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args t) j
balanceReportAsText :: [Opt] -> BalanceReport -> String
balanceReportAsText opts (items,total) =
unlines $
map (balanceReportItemAsText opts) items
++
if NoTotal `elem` opts
then []
else ["--------------------"
,padleft 20 $ showMixedAmountWithoutPrice total
]
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
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
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
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