module Hledger.Cli.Commands.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
balance :: [Opt] -> [String] -> Journal -> IO ()
balance opts args j = do
t <- getCurrentLocalTime
putStr $ showBalanceReport opts (optsToFilterSpec opts args t) j
showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String
showBalanceReport opts filterspec j = 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
totalstr | NoTotal `elem` opts = ""
| otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total
where
total = sum $ map abalance $ ledgerTopAccounts l
showInterestingAccount :: [Opt] -> Ledger -> [AccountName] -> AccountName -> String
showInterestingAccount opts l interestingaccts a = concatTopPadded [amt, " ", name]
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
partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
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