hledger/Account.hs

module Account
where
import qualified Data.Map as Map

import Utils
import Types
import AccountName
import Amount
import Entry
import Transaction
import EntryTransaction
import Ledger


-- an Account caches an account's name, balance (including sub-accounts)
-- and transactions (excluding sub-accounts)
data Account = Account {
      aname :: AccountName, 
      atransactions :: [EntryTransaction],
      abalance :: Amount
}

instance Show Account where
    show (Account a ts b) = printf "Account %s with %d transactions" a $ length ts

nullacct = Account "" [] nullamt

ledgerAccount :: Ledger -> AccountName -> Account
ledgerAccount l a = 
    Account 
    a 
    (transactionsInAccountNamed l a) 
    (aggregateBalanceInAccountNamed l a)

-- queries

balanceInAccountNamed :: Ledger -> AccountName -> Amount
balanceInAccountNamed l a = 
    sumEntryTransactions (transactionsInAccountNamed l a)

aggregateBalanceInAccountNamed :: Ledger -> AccountName -> Amount
aggregateBalanceInAccountNamed l a = 
    sumEntryTransactions (aggregateTransactionsInAccountNamed l a)

transactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction]
transactionsInAccountNamed l a =
    ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l

aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction]
aggregateTransactionsInAccountNamed l a = 
    ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l

-- build a tree of Accounts
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
addDataToAccountNameTree l ant = 
    Node 
    (ledgerAccount l $ root ant) 
    (map (addDataToAccountNameTree l) $ branches ant)

-- balance report support
--
-- examples, ignoring the issue of eliding boring accounts:
-- here is a sample account tree:
--
-- assets
--  cash
--  checking
--  saving
-- equity
-- expenses
--  food
--  shelter
-- income
--  salary
-- liabilities
--  debts
--
-- standard balance command shows all top-level accounts:
--
-- > ledger bal
-- $ assets      
-- $ equity
-- $ expenses    
-- $ income      
-- $ liabilities 
--
-- with an account pattern, show only the ones with matching names:
--
-- > ledger bal asset
-- $ assets      
--
-- with -s, show all subaccounts of matched accounts:
--
-- > ledger -s bal asset
-- $ assets      
-- $  cash       
-- $  checking   
-- $  saving

showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
showLedgerAccounts l acctpats showsubs maxdepth = 
    concatMap 
    (showAccountTree l) 
    (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))

ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
ledgerAccountTreeMatching l [] showsubs maxdepth = 
    ledgerAccountTreeMatching l [".*"] showsubs maxdepth
ledgerAccountTreeMatching l acctpats showsubs maxdepth = 
    addDataToAccountNameTree l $ 
    filterAccountNameTree acctpats showsubs maxdepth $ 
    ledgerAccountNameTree l

-- when displaying an account tree, we elide boring accounts.
-- 1. leaf accounts and branches with 0 balance or 0 transactions are omitted
-- 2. inner accounts with 0 transactions and 1 subaccount are displayed as
--    a prefix of the sub
--
-- example:
--
-- a (0 txns)
--   b (0 txns)
--     c
--       d
-- e (0 txns)
--   f
--   g
-- h (0 txns)
--   i (0 balance)
--
-- displays as:
--
-- a:b:c
--   d
-- e
--   f
--   g
showAccountTree :: Ledger -> Tree Account -> String
showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom

showAccountTree' l indentlevel t
    -- if this acct is boring, don't show it
    | isBoringInnerAccount l acct = subacctsindented 0
    -- otherwise show normal indented account name with balance, 
    -- prefixing the names of any boring parents
    | otherwise = 
        bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subacctsindented 1)
    where
      acct = root t
      subacctsindented i = concatMap (showAccountTree' l (indentlevel+i)) $ branches t
      bal = printf "%20s" $ show $ abalance $ acct
      indent = replicate (indentlevel * 2) ' '
      prefix = concatMap (++ ":") $ map accountLeafName boringparents
      boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct
      leafname = accountLeafName $ aname acct

isBoringInnerAccount :: Ledger -> Account -> Bool
isBoringInnerAccount l a
    | name == "top" = False
    | (length txns == 0) && ((length subs) == 1) = True
    | otherwise = False
    where
      name = aname a
      txns = atransactions a
      subs = subAccountNamesFrom (ledgerAccountNames l) name

-- darnit, still need this
isBoringInnerAccountName :: Ledger -> AccountName -> Bool
isBoringInnerAccountName l name
    | name == "top" = False
    | (length txns == 0) && ((length subs) == 1) = True
    | otherwise = False
    where
      txns = transactionsInAccountNamed l name
      subs = subAccountNamesFrom (ledgerAccountNames l) name

interestingAccountsFrom :: Tree Account -> Tree Account
interestingAccountsFrom =
    treefilter hastxns . treefilter hasbalance
    where 
      hasbalance = (/= 0) . abalance
      hastxns = (> 0) . length . atransactions

ledgerAccountTree :: Ledger -> Tree Account
ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l)