module Ledger.Ledger
where
import qualified Data.Map as Map
import Data.Map ((!))
import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.AccountName
import Ledger.Account
import Ledger.Transaction
import Ledger.RawLedger
import Ledger.LedgerTransaction
instance Show Ledger where
show l = printf "Ledger with %d transactions, %d accounts\n%s"
((length $ ledger_txns $ rawledger l) +
(length $ modifier_txns $ rawledger l) +
(length $ periodic_txns $ rawledger l))
(length $ accountnames l)
(showtree $ accountnametree l)
cacheLedger :: [String] -> RawLedger -> Ledger
cacheLedger apats l = Ledger{rawledgertext="",rawledger=l,accountnametree=ant,accountmap=acctmap}
where
(ant,txnsof,_,inclbalof) = groupTransactions $ filtertxns apats $ rawLedgerTransactions l
acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant]
where mkacct a = Account a (txnsof a) (inclbalof a)
groupTransactions :: [Transaction] -> (Tree AccountName,
(AccountName -> [Transaction]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
where
txnanames = sort $ nub $ map taccount ts
ant = accountNameTreeFrom $ expandAccountNames $ txnanames
allanames = flatten ant
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
balmap = Map.fromList $ flatten $ calculateBalances ant txnsof
txnsof = (txnmap !)
exclbalof = fst . (balmap !)
inclbalof = snd . (balmap !)
calculateBalances :: Tree AccountName -> (AccountName -> [Transaction]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant txnsof = addbalances ant
where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where
bal = sumTransactions $ txnsof a
subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs
transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction]
transactionsByAccount ts = m'
where
sortedts = sortBy (comparing taccount) ts
groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts
m' = Map.fromList [(taccount $ head g, g) | g <- groupedts]
filtertxns :: [String] -> [Transaction] -> [Transaction]
filtertxns apats ts = filter (matchpats apats . taccount) ts
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames l = drop 1 $ flatten $ accountnametree l
ledgerAccount :: Ledger -> AccountName -> Account
ledgerAccount l a = (accountmap l) ! a
ledgerAccounts :: Ledger -> [Account]
ledgerAccounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts l = map root $ branches $ ledgerAccountTree 9999 l
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
ledgerAccountsMatching pats l = filter (matchpats pats . aname) $ accounts l
ledgerSubAccounts :: Ledger -> Account -> [Account]
ledgerSubAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l
ledgerTransactions :: Ledger -> [Transaction]
ledgerTransactions l = rawLedgerTransactions $ rawledger l
ledgerAccountTree :: Int -> Ledger -> Tree Account
ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accountnametree l
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan l
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
where
ts = sortBy (comparing tdate) $ ledgerTransactions l
accountnames :: Ledger -> [AccountName]
accountnames = ledgerAccountNames
account :: Ledger -> AccountName -> Account
account = ledgerAccount
accounts :: Ledger -> [Account]
accounts = ledgerAccounts
topaccounts :: Ledger -> [Account]
topaccounts = ledgerTopAccounts
accountsmatching :: [String] -> Ledger -> [Account]
accountsmatching = ledgerAccountsMatching
subaccounts :: Ledger -> Account -> [Account]
subaccounts = ledgerSubAccounts
transactions :: Ledger -> [Transaction]
transactions = ledgerTransactions
accounttree :: Int -> Ledger -> Tree Account
accounttree = ledgerAccountTree
accounttreeat :: Ledger -> Account -> Maybe (Tree Account)
accounttreeat = ledgerAccountTreeAt
datespan :: Ledger -> DateSpan
datespan = ledgerDateSpan
rawdatespan :: Ledger -> DateSpan
rawdatespan = rawLedgerDateSpan . rawledger
ledgeramounts :: Ledger -> [MixedAmount]
ledgeramounts = rawLedgerAmounts . rawledger