module Ledger.Ledger
where
import qualified Data.Map as Map
import Data.Map ((!))
import Ledger.Utils
import Ledger.Types
import Ledger.Account ()
import Ledger.AccountName
import Ledger.Transaction
import Ledger.RawLedger
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 = filter (matchpats apats . taccount)
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = drop 1 . flatten . accountnametree
ledgerAccount :: Ledger -> AccountName -> Account
ledgerAccount = (!) . accountmap
ledgerAccounts :: Ledger -> [Account]
ledgerAccounts = drop 1 . flatten . ledgerAccountTree 9999
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts = map root . branches . ledgerAccountTree 9999
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
ledgerAccountsMatching pats = filter (matchpats pats . aname) . accounts
ledgerSubAccounts :: Ledger -> Account -> [Account]
ledgerSubAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l
ledgerTransactions :: Ledger -> [Transaction]
ledgerTransactions = rawLedgerTransactions . rawledger
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
commodities :: Ledger -> [Commodity]
commodities = nub . rawLedgerCommodities . rawledger
accounttree :: Int -> Ledger -> Tree Account
accounttree = ledgerAccountTree
accounttreeat :: Ledger -> Account -> Maybe (Tree Account)
accounttreeat = ledgerAccountTreeAt
rawdatespan :: Ledger -> DateSpan
rawdatespan = rawLedgerDateSpan . rawledger
ledgeramounts :: Ledger -> [MixedAmount]
ledgeramounts = rawLedgerAmounts . rawledger