76df6ec88f
from:
total time = 0.14 secs (7 ticks @ 20 ms)
total alloc = 275,520,536 bytes (excludes profiling overheads)
cacheLedger 1 0.0 0.1 42.9 48.6
sumTransactions 0 0.0 0.6 28.6 42.5
isZeroAmount 13529 0.0 2.0 14.3 39.2
showAmount 13529 0.0 7.2 14.3 37.2
showAmount' 13529 14.3 29.9 14.3 29.9
con2tag_Side# 27232 0.0 0.0 0.0 0.0
normaliseMixedAmount 6733 0.0 1.8 14.3 2.7
con2tag_Side# 120 0.0 0.0 0.0 0.0
sumAmountsPreservingPrice 6803 0.0 0.2 14.3 1.0
amountop 13351 0.0 0.4 14.3 0.8
convertAmountTo 13351 14.3 0.4 14.3 0.4
conversionRate 13351 0.0 0.0 0.0 0.0
isAccountNamePrefixOf 25122 0.0 2.0 0.0 2.0
to:
total time = 0.08 secs (4 ticks @ 20 ms)
total alloc = 168,637,964 bytes (excludes profiling overheads)
cacheLedger 1 0.0 0.1 0.0 27.1
sumTransactions 0 0.0 0.3 0.0 18.8
isZeroAmount 3931 0.0 0.9 0.0 17.3
showAmount 3931 0.0 3.4 0.0 16.3
showAmount' 3931 0.0 12.9 0.0 12.9
con2tag_Side# 7884 0.0 0.0 0.0 0.0
normaliseMixedAmount 1964 0.0 0.8 0.0 1.3
con2tag_Side# 12 0.0 0.0 0.0 0.0
sumAmountsPreservingPrice 1970 0.0 0.1 0.0 0.5
amountop 3793 0.0 0.2 0.0 0.4
convertAmountTo 3793 0.0 0.2 0.0 0.2
conversionRate 3793 0.0 0.0 0.0 0.0
114 lines
4.3 KiB
Haskell
114 lines
4.3 KiB
Haskell
{-|
|
|
|
|
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
|
|
names, and a map from account names to 'Account's. It may also have had
|
|
uninteresting 'Entry's and 'Transaction's filtered out. It also stores
|
|
the complete ledger file text for the ui command.
|
|
|
|
-}
|
|
|
|
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)
|
|
|
|
-- | Convert a raw ledger to a more efficient cached type, described above.
|
|
cacheLedger :: [String] -> RawLedger -> Ledger
|
|
cacheLedger apats l = Ledger{rawledgertext="",rawledger=l,accountnametree=ant,accountmap=acctmap}
|
|
where
|
|
ts = filtertxns apats $ rawLedgerTransactions l
|
|
ant = rawLedgerAccountNameTree l
|
|
|
|
anames = flatten ant
|
|
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- anames])
|
|
txnsof = (txnmap !)
|
|
|
|
-- add subaccount-including balances to a tree of account names
|
|
-- somewhat efficiently
|
|
addbalances :: Tree AccountName -> Tree (AccountName, MixedAmount)
|
|
addbalances (Node a []) = Node (a,sumTransactions $ txnsof a) []
|
|
addbalances (Node a subs) = Node (a,sumtxns + sumsubaccts) subbals
|
|
where
|
|
sumtxns = sumTransactions $ txnsof a
|
|
sumsubaccts = sum $ map (snd . root) subbals
|
|
subbals = map addbalances subs
|
|
balmap = Map.fromList $ flatten $ addbalances ant
|
|
balof = (balmap !)
|
|
|
|
mkacct a = Account a (txnsof a) (balof a)
|
|
acctmap = Map.fromList [(a, mkacct a) | a <- anames]
|
|
|
|
|
|
-- | Convert a list of transactions to a map from account name to the list
|
|
-- of all transactions in that account.
|
|
transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction]
|
|
transactionsByAccount ts = Map.fromList [(account $ head g, g) | g <- groupedts]
|
|
where
|
|
sortedts = sortBy (comparing account) ts
|
|
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
|
|
|
filtertxns :: [String] -> [Transaction] -> [Transaction]
|
|
filtertxns apats ts = filter (matchpats apats . account) ts
|
|
|
|
-- | List a ledger's account names.
|
|
accountnames :: Ledger -> [AccountName]
|
|
accountnames l = drop 1 $ flatten $ accountnametree l
|
|
|
|
-- | Get the named account from a ledger.
|
|
ledgerAccount :: Ledger -> AccountName -> Account
|
|
ledgerAccount l a = (accountmap l) ! a
|
|
|
|
-- | List a ledger's accounts, in tree order
|
|
accounts :: Ledger -> [Account]
|
|
accounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
|
|
|
|
-- | List a ledger's top-level accounts, in tree order
|
|
topAccounts :: Ledger -> [Account]
|
|
topAccounts l = map root $ branches $ ledgerAccountTree 9999 l
|
|
|
|
-- | Accounts in ledger whose name matches the pattern, in tree order.
|
|
accountsMatching :: [String] -> Ledger -> [Account]
|
|
accountsMatching pats l = filter (matchpats pats . aname) $ accounts l
|
|
|
|
-- | List a ledger account's immediate subaccounts
|
|
subAccounts :: Ledger -> Account -> [Account]
|
|
subAccounts l Account{aname=a} =
|
|
map (ledgerAccount l) $ filter (a `isAccountNamePrefixOf`) $ accountnames l
|
|
|
|
-- | List a ledger's transactions.
|
|
ledgerTransactions :: Ledger -> [Transaction]
|
|
ledgerTransactions l = rawLedgerTransactions $ rawledger l
|
|
|
|
-- | Get a ledger's tree of accounts to the specified depth.
|
|
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
|
ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accountnametree l
|
|
|
|
-- | Get a ledger's tree of accounts rooted at the specified account.
|
|
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
|
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
|
|
|
-- | The (explicit) date span containing all the ledger's transactions,
|
|
-- or DateSpan Nothing Nothing if there are no transactions.
|
|
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
|