390 lines
14 KiB
Haskell
390 lines
14 KiB
Haskell
{-|
|
|
|
|
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
|
|
names, a map from account names to 'Account's, and the display precision.
|
|
Typically it has also has had the uninteresting 'Entry's and
|
|
'Transaction's filtered out.
|
|
|
|
Also, the account filter pattern is stored.
|
|
|
|
-}
|
|
|
|
module Ledger.Ledger (
|
|
cacheLedger,
|
|
filterLedgerEntries,
|
|
accountnames,
|
|
ledgerAccount,
|
|
ledgerTransactions,
|
|
ledgerAccountTree,
|
|
addDataToAccountNameTree,
|
|
printentries,
|
|
printregister,
|
|
showLedgerAccountBalances,
|
|
showAccountTree,
|
|
isBoringInnerAccount,
|
|
isBoringInnerAccountName,
|
|
-- pruneBoringBranches,
|
|
)
|
|
where
|
|
import qualified Data.Map as Map
|
|
import Data.Map ((!))
|
|
import Ledger.Utils
|
|
import Ledger.Types
|
|
import Ledger.Amount
|
|
import Ledger.Account
|
|
import Ledger.AccountName
|
|
import Ledger.Transaction
|
|
import Ledger.RawLedger
|
|
import Ledger.Entry
|
|
|
|
|
|
instance Show Ledger where
|
|
show l = printf "Ledger with %d entries, %d accounts: %s"
|
|
((length $ entries $ rawledger l) +
|
|
(length $ modifier_entries $ rawledger l) +
|
|
(length $ periodic_entries $ rawledger l))
|
|
(length $ accountnames l)
|
|
(show $ accountnames l)
|
|
++ "\n" ++ (showtree $ accountnametree l)
|
|
++ "\n" ++ (showtree $ filteredaccountnametree l)
|
|
|
|
-- | Convert a raw ledger to a more efficient cached type, described above.
|
|
cacheLedger :: Regex -> RawLedger -> Ledger
|
|
cacheLedger acctpat l =
|
|
let
|
|
ant = rawLedgerAccountNameTree l
|
|
anames = flatten ant
|
|
ts = rawLedgerTransactions l
|
|
sortedts = sortBy (comparing account) ts
|
|
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
|
txnmap = Map.union
|
|
(Map.fromList [(account $ head g, g) | g <- groupedts])
|
|
(Map.fromList [(a,[]) | a <- anames])
|
|
txnsof = (txnmap !)
|
|
subacctsof a = filter (isAccountNamePrefixOf a) anames
|
|
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
|
|
balmap = Map.union
|
|
(Map.fromList [(a, (sumTransactions $ subtxnsof a){precision=maxprecision}) | a <- anames])
|
|
(Map.fromList [(a,nullamt) | a <- anames])
|
|
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
|
-- the same again, considering only accounts and transactions matching the account pattern
|
|
matchacct :: AccountName -> Bool
|
|
matchacct = containsRegex acctpat . accountLeafName
|
|
filteredant = treefilter matchacct ant
|
|
-- rebuild the tree after filtering to include all parents
|
|
filteredanames = flatten $ accountNameTreeFrom $ filter matchacct anames
|
|
filteredts = filter (matchacct . account) ts
|
|
filteredsortedts = sortBy (comparing account) filteredts
|
|
filteredgroupedts = groupBy (\t1 t2 -> account t1 == account t2) filteredsortedts
|
|
filteredtxnmap = Map.union
|
|
(Map.fromList [(account $ head g, g) | g <- filteredgroupedts])
|
|
(Map.fromList [(a,[]) | a <- filteredanames])
|
|
filteredtxnsof = (filteredtxnmap !)
|
|
filteredsubacctsof a = filter (isAccountNamePrefixOf a) filteredanames
|
|
filteredsubtxnsof a = concat [filteredtxnsof a | a <- [a] ++ filteredsubacctsof a]
|
|
filteredbalmap = Map.union
|
|
(Map.fromList [(a, (sumTransactions $ filteredsubtxnsof a){precision=maxprecision}) | a <- filteredanames])
|
|
(Map.fromList [(a,nullamt) | a <- filteredanames])
|
|
filteredamap = Map.fromList [(a, Account a (filteredtxnmap ! a) (filteredbalmap ! a)) | a <- filteredanames]
|
|
|
|
maxprecision = maximum $ map (precision . amount) ts
|
|
in
|
|
Ledger l ant amap maxprecision acctpat filteredant filteredamap
|
|
|
|
-- | Remove ledger entries we are not interested in.
|
|
-- Keep only those which fall between the begin and end dates, match the
|
|
-- description patterns, or transact with an account matching the account
|
|
-- patterns.
|
|
filterLedgerEntries :: String -> String -> Regex -> Regex -> RawLedger -> RawLedger
|
|
filterLedgerEntries begin end acctpat descpat =
|
|
-- strace .
|
|
-- filterLedgerEntriesByTransactionAccount acctpat .
|
|
filterLedgerEntriesByDate begin end .
|
|
filterLedgerEntriesByDescription descpat
|
|
|
|
-- | Keep only entries whose description matches the description pattern.
|
|
filterLedgerEntriesByDescription :: Regex -> RawLedger -> RawLedger
|
|
filterLedgerEntriesByDescription descpat (RawLedger ms ps es f) =
|
|
RawLedger ms ps (filter matchdesc es) f
|
|
where
|
|
matchdesc :: Entry -> Bool
|
|
matchdesc e = case matchRegex descpat (edescription e) of
|
|
Nothing -> False
|
|
otherwise -> True
|
|
|
|
-- | Keep only entries which fall between begin and end dates.
|
|
-- We include entries on the begin date and exclude entries on the end
|
|
-- date, like ledger. An empty date string means no restriction.
|
|
filterLedgerEntriesByDate :: String -> String -> RawLedger -> RawLedger
|
|
filterLedgerEntriesByDate begin end (RawLedger ms ps es f) =
|
|
RawLedger ms ps (filter matchdate es) f
|
|
where
|
|
matchdate :: Entry -> Bool
|
|
matchdate e = (begin == "" || entrydate >= begindate) &&
|
|
(end == "" || entrydate < enddate)
|
|
where
|
|
begindate = parsedate begin :: UTCTime
|
|
enddate = parsedate end
|
|
entrydate = parsedate $ edate e
|
|
|
|
-- | Keep only entries which have at least one transaction with an account
|
|
-- whose (leaf) name matches the pattern.
|
|
filterLedgerEntriesByTransactionAccount :: Regex -> RawLedger -> RawLedger
|
|
filterLedgerEntriesByTransactionAccount acctpat l@(RawLedger _ _ es _) =
|
|
l{entries=filter matchentry es}
|
|
where
|
|
matchentry = any matchtxn . etransactions
|
|
matchtxn = containsRegex acctpat . accountLeafName . taccount
|
|
|
|
-- -- | Remove entries which have no transactions.
|
|
-- filterEmptyLedgerEntries :: RawLedger -> RawLedger
|
|
-- filterEmptyLedgerEntries (RawLedger ms ps es f) =
|
|
-- RawLedger ms ps (filter (not . null . etransactions) es) f
|
|
|
|
-- -- | In each ledger entry, filter out transactions which do not match the
|
|
-- -- matcher. Entries are no longer balanced after this.
|
|
-- filterLedgerTransactionsBy :: (RawTransaction -> Bool) -> RawLedger -> RawLedger
|
|
-- filterLedgerTransactionsBy matcher (RawLedger ms ps es f) =
|
|
-- RawLedger ms ps (map filterentrytxns es) f
|
|
-- where
|
|
-- filterentrytxns e@(Entry _ _ _ _ _ ts _) = e{etransactions=filter matcher ts}
|
|
|
|
matchtxnacctname :: Regex -> RawTransaction -> Bool
|
|
matchtxnacctname acctpat t = case matchRegex acctpat (taccount t) of
|
|
Nothing -> False
|
|
otherwise -> True
|
|
|
|
matchtxnleafname :: Regex -> RawTransaction -> Bool
|
|
matchtxnleafname acctpat t = case matchRegex acctpat (accountLeafName $ taccount t) of
|
|
Nothing -> False
|
|
otherwise -> True
|
|
|
|
-- | List a 'Ledger' 's account names.
|
|
accountnames :: Ledger -> [AccountName]
|
|
accountnames l = drop 1 $ flatten $ accountnametree l
|
|
|
|
-- | List a 'Ledger' 's account names filtered by the account match pattern.
|
|
filteredaccountnames :: Ledger -> [AccountName]
|
|
filteredaccountnames l = filter (containsRegex (acctpat l) . accountLeafName) $ accountnames l
|
|
|
|
-- | Get the named account from a ledger.
|
|
ledgerAccount :: Ledger -> AccountName -> Account
|
|
ledgerAccount l a = (accounts l) ! a
|
|
|
|
-- | Get the named filtered account from a ledger.
|
|
ledgerFilteredAccount :: Ledger -> AccountName -> Account
|
|
ledgerFilteredAccount l a = (filteredaccounts l) ! a
|
|
|
|
-- | List a ledger's transactions.
|
|
--
|
|
-- NB this sets the amount precisions to that of the highest-precision
|
|
-- amount, to help with report output. It should perhaps be done in the
|
|
-- display functions, but those are far removed from the ledger. Keep in
|
|
-- mind if doing more arithmetic with these.
|
|
ledgerTransactions :: Ledger -> [Transaction]
|
|
ledgerTransactions l =
|
|
setprecisions $ rawLedgerTransactions $ rawledger l
|
|
where
|
|
setprecisions = map (transactionSetPrecision (lprecision l))
|
|
|
|
-- | Get a ledger's tree of accounts to the specified depth.
|
|
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
|
ledgerAccountTree depth l =
|
|
addDataToAccountNameTree l depthpruned
|
|
where
|
|
nametree = filteredaccountnametree l --
|
|
depthpruned = treeprune depth nametree
|
|
|
|
-- | Get a ledger's tree of accounts to the specified depth, filtered by
|
|
-- the account pattern.
|
|
ledgerFilteredAccountTree :: Int -> Regex -> Ledger -> Tree Account
|
|
ledgerFilteredAccountTree depth acctpat l =
|
|
addFilteredDataToAccountNameTree l $ treeprune depth $ filteredaccountnametree l
|
|
|
|
-- | Convert a tree of account names into a tree of accounts, using their
|
|
-- parent ledger.
|
|
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
|
addDataToAccountNameTree = treemap . ledgerAccount
|
|
|
|
-- | Convert a tree of account names into a tree of accounts, using their
|
|
-- parent ledger's filtered account data.
|
|
addFilteredDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
|
addFilteredDataToAccountNameTree l = treemap (ledgerFilteredAccount l)
|
|
|
|
-- | Print a print report.
|
|
printentries :: Ledger -> IO ()
|
|
printentries l = putStr $ showEntries $ setprecisions $ entries $ rawledger l
|
|
where setprecisions = map (entrySetPrecision (lprecision l))
|
|
|
|
-- | Print a register report.
|
|
printregister :: Ledger -> IO ()
|
|
printregister l = putStr $ showTransactionsWithBalances
|
|
(sortBy (comparing date) $ ledgerTransactions l)
|
|
nullamt{precision=lprecision l}
|
|
|
|
{-|
|
|
This and the helper functions below generate ledger-compatible balance
|
|
report output. Here's how it should work:
|
|
|
|
A sample account tree (as in the sample.ledger file):
|
|
|
|
@
|
|
assets
|
|
cash
|
|
checking
|
|
saving
|
|
expenses
|
|
food
|
|
supplies
|
|
income
|
|
gifts
|
|
salary
|
|
liabilities
|
|
debts
|
|
@
|
|
|
|
The balance command shows top-level accounts by default:
|
|
|
|
@
|
|
\> ledger balance
|
|
$-1 assets
|
|
$2 expenses
|
|
$-2 income
|
|
$1 liabilities
|
|
@
|
|
|
|
With -s (--showsubs), also show the subaccounts:
|
|
|
|
@
|
|
$-1 assets
|
|
$-2 cash
|
|
$1 saving
|
|
$2 expenses
|
|
$1 food
|
|
$1 supplies
|
|
$-2 income
|
|
$-1 gifts
|
|
$-1 salary
|
|
$1 liabilities:debts
|
|
@
|
|
|
|
- @checking@ is not shown because it has a zero balance and no interesting
|
|
subaccounts.
|
|
|
|
- @liabilities@ is displayed only as a prefix because it has no transactions
|
|
of its own and only one subaccount.
|
|
|
|
With an account pattern, show only the accounts with matching names:
|
|
|
|
@
|
|
\> ledger balance o
|
|
$1 expenses:food
|
|
$-2 income
|
|
--------------------
|
|
$-1
|
|
@
|
|
|
|
- The o matched @food@ and @income@, so they are shown.
|
|
|
|
- Parents of matched accounts are also shown for context (@expenses@).
|
|
|
|
- This time the grand total is also shown, because it is not zero.
|
|
|
|
Again, -s adds the subaccounts:
|
|
|
|
@
|
|
\> ledger -s balance o
|
|
$1 expenses:food
|
|
$-2 income
|
|
$-1 gifts
|
|
$-1 salary
|
|
--------------------
|
|
$-1
|
|
@
|
|
|
|
- @food@ has no subaccounts. @income@ has two, so they are shown.
|
|
|
|
- We do not add the subaccounts of parents included for context (@expenses@).
|
|
|
|
Here are some rules for account balance display, as seen above:
|
|
|
|
- grand total is omitted if it is 0
|
|
|
|
- leaf accounts and branches with 0 balance or 0 transactions are omitted
|
|
|
|
- inner accounts with 0 transactions and 1 subaccount are displayed inline
|
|
|
|
- in a filtered report, matched accounts are displayed with their parents
|
|
inline (a consequence of the above)
|
|
|
|
- in a showsubs report, all subaccounts of matched accounts are displayed
|
|
|
|
-}
|
|
showLedgerAccountBalances :: Ledger -> Int -> String
|
|
showLedgerAccountBalances l maxdepth =
|
|
concatMap (showAccountTree l maxdepth) acctbranches
|
|
++
|
|
if isZeroAmount total
|
|
then ""
|
|
else printf "--------------------\n%20s\n" $ showAmountRounded total
|
|
where
|
|
acctbranches = branches $ ledgerAccountTree maxdepth l
|
|
filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l
|
|
total = sum $ map (abalance . root) filteredacctbranches
|
|
|
|
-- | Get the string representation of a tree of accounts.
|
|
-- The ledger from which the accounts come is also required, so that
|
|
-- we can check for boring accounts.
|
|
showAccountTree :: Ledger -> Int -> Tree Account -> String
|
|
showAccountTree l maxdepth = showAccountTree' l maxdepth 0 ""
|
|
|
|
showAccountTree' :: Ledger -> Int -> Int -> String -> Tree Account -> String
|
|
showAccountTree' l maxdepth indentlevel prefix t
|
|
-- prefix boring inner account names to the next line
|
|
| isBoringInnerAccount l maxdepth acct = subsindented 0 (fullname++":")
|
|
-- ditto with unmatched parent accounts when filtering by account
|
|
| filtering && doesnotmatch = subsindented 0 (fullname++":")
|
|
-- otherwise show this account's name & balance
|
|
| otherwise = bal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subsindented 1 "")
|
|
where
|
|
acct = root t
|
|
subs = branches t
|
|
subsindented i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subs
|
|
bal = printf "%20s" $ show $ abalance $ acct
|
|
indent = replicate (indentlevel * 2) ' '
|
|
fullname = aname acct
|
|
leafname = accountLeafName fullname
|
|
filtering = filteredaccountnames l /= (accountnames l)
|
|
doesnotmatch = not (containsRegex (acctpat l) leafname)
|
|
|
|
-- | Is this account a boring inner account in this ledger ?
|
|
-- Boring inner accounts have no transactions, one subaccount,
|
|
-- and depth less than the maximum display depth.
|
|
-- Also, they are unmatched parent accounts when account matching is in effect.
|
|
isBoringInnerAccount :: Ledger -> Int -> Account -> Bool
|
|
isBoringInnerAccount l maxdepth a
|
|
| name == "top" = False
|
|
| depth < maxdepth && numtxns == 0 && numsubs == 1 = True
|
|
| otherwise = False
|
|
where
|
|
name = aname a
|
|
depth = accountNameLevel name
|
|
numtxns = length $ atransactions a
|
|
-- how many (filter-matching) subaccounts has this account ?
|
|
numsubs = length $ subAccountNamesFrom (filteredaccountnames l) name
|
|
|
|
-- | Is the named account a boring inner account in this ledger ?
|
|
isBoringInnerAccountName :: Ledger -> Int -> AccountName -> Bool
|
|
isBoringInnerAccountName l maxdepth = isBoringInnerAccount l maxdepth . ledgerAccount l
|
|
|
|
-- | Remove boring branches (and leaves) from a tree of accounts.
|
|
-- A boring branch contains only accounts which have a 0 balance or no
|
|
-- transactions.
|
|
-- pruneBoringBranches :: Tree Account -> Tree Account
|
|
-- pruneBoringBranches =
|
|
-- treefilter hastxns . treefilter hasbalance
|
|
-- where
|
|
-- hasbalance = (/= 0) . abalance
|
|
-- hastxns = (> 0) . length . atransactions
|
|
|