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.Entry
instance Show Ledger where
show l = printf "Ledger with %d entries, %d accounts\n%s"
((length $ entries $ rawledger l) +
(length $ modifier_entries $ rawledger l) +
(length $ periodic_entries $ rawledger l))
(length $ accountnames l)
(showtree $ accountnametree l)
cacheLedger :: [String] -> RawLedger -> Ledger
cacheLedger apats l = Ledger{rawledgertext="",rawledger=l,accountnametree=ant,accountmap=acctmap}
where
acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant]
mkacct a = Account a (txnsof a) (inclbalof a)
ts = filtertxns apats $ rawLedgerTransactions l
(ant,txnsof,_,inclbalof) = groupTransactions ts
groupTransactions :: [Transaction] -> (Tree AccountName,
(AccountName -> [Transaction]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
where
txnanames = sort $ nub $ map account 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 account) ts
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
m' = Map.fromList [(account $ head g, g) | g <- groupedts]
filtertxns :: [String] -> [Transaction] -> [Transaction]
filtertxns apats ts = filter (matchpats apats . account) ts
accountnames :: Ledger -> [AccountName]
accountnames l = drop 1 $ flatten $ accountnametree l
ledgerAccount :: Ledger -> AccountName -> Account
ledgerAccount l a = (accountmap l) ! a
accounts :: Ledger -> [Account]
accounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
topAccounts :: Ledger -> [Account]
topAccounts l = map root $ branches $ ledgerAccountTree 9999 l
accountsMatching :: [String] -> Ledger -> [Account]
accountsMatching pats l = filter (matchpats pats . aname) $ accounts l
subAccounts :: Ledger -> Account -> [Account]
subAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (a `isAccountNamePrefixOf`) $ 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 l
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ date $ head ts) (Just $ addDays 1 $ date $ last ts)
where
ts = sortBy (comparing date) $ ledgerTransactions l