hledger/Ledger.hs

222 lines
7.1 KiB
Haskell
Raw Normal View History

module Ledger
where
2007-03-10 02:32:00 +03:00
import qualified Data.Map as Map
2007-07-03 03:41:07 +04:00
import Data.Map ((!))
import Utils
2007-07-02 18:54:36 +04:00
import Types
2007-07-03 09:43:00 +04:00
import Amount
import Account
import AccountName
import Transaction
import LedgerFile
rawLedgerTransactions :: LedgerFile -> [Transaction]
2007-07-04 14:59:29 +04:00
rawLedgerTransactions = txns . entries
where
txns :: [LedgerEntry] -> [Transaction]
txns es = concat $ map flattenEntry $ zip es (iterate (+1) 1)
2007-07-04 13:28:07 +04:00
rawLedgerAccountNamesUsed :: LedgerFile -> [AccountName]
2007-07-04 14:59:29 +04:00
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
2007-07-04 13:28:07 +04:00
rawLedgerAccountNames :: LedgerFile -> [AccountName]
2007-07-04 13:28:07 +04:00
rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
rawLedgerAccountNameTree :: LedgerFile -> Tree AccountName
2007-07-04 13:28:07 +04:00
rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
instance Show Ledger where
show l = printf "Ledger with %d entries, %d accounts"
((length $ entries $ rawledger l) +
(length $ modifier_entries $ rawledger l) +
(length $ periodic_entries $ rawledger l))
(length $ accountnames l)
-- at startup, to improve performance, we refine the parsed ledger entries:
-- 1. filter based on account/description patterns, if any
-- 2. cache per-account info
-- also, figure out the precision(s) to use
cacheLedger :: FilterPatterns -> LedgerFile -> Ledger
cacheLedger pats l =
2007-07-03 03:41:07 +04:00
let
lprecision = maximum $ map (precision . amount) $ rawLedgerTransactions l
l' = filterLedgerEntries pats l
l'' = filterLedgerTransactions pats l'
ant = rawLedgerAccountNameTree l''
2007-07-03 03:41:07 +04:00
ans = flatten ant
ts = rawLedgerTransactions l''
2007-07-03 09:43:00 +04:00
sortedts = sortBy (comparing account) ts
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
tmap = Map.union
(Map.fromList [(account $ head g, g) | g <- groupedts])
(Map.fromList [(a,[]) | a <- ans])
2007-07-04 14:59:29 +04:00
txns = (tmap !)
2007-07-03 10:16:15 +04:00
subaccts a = filter (isAccountNamePrefixOf a) ans
subtxns a = concat [txns a | a <- [a] ++ subaccts a]
2007-07-03 09:43:00 +04:00
bmap = Map.union
2007-07-04 14:59:29 +04:00
(Map.fromList [(a, (sumTransactions $ subtxns a){precision=lprecision}) | a <- ans])
2007-07-03 09:43:00 +04:00
(Map.fromList [(a,nullamt) | a <- ans])
amap = Map.fromList [(a, Account a (tmap ! a) (bmap ! a)) | a <- ans]
2007-07-03 03:41:07 +04:00
in
Ledger l' ant amap lprecision
-- filter entries by description and whether any transactions match account patterns
filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile
filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es f) =
LedgerFile ms ps (filter matchdesc $ filter (any matchtxn . etransactions) es) f
where
matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
Nothing -> False
otherwise -> True
matchdesc e = case matchRegex (wilddefault descpat) (edescription e) of
Nothing -> False
otherwise -> True
2007-07-03 03:41:07 +04:00
-- filter transactions in each ledger entry by account patterns
-- this may unbalance entries
filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile
filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =
LedgerFile ms ps (map filterentrytxns es) f
2007-07-09 22:54:41 +04:00
where
filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts}
matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
Nothing -> False
otherwise -> True
wilddefault = fromMaybe (mkRegex ".*")
2007-07-09 22:54:41 +04:00
2007-07-03 12:46:39 +04:00
accountnames :: Ledger -> [AccountName]
accountnames l = flatten $ accountnametree l
2007-07-03 03:41:07 +04:00
ledgerAccount :: Ledger -> AccountName -> Account
2007-07-03 12:46:39 +04:00
ledgerAccount l a = (accounts l) ! a
-- This sets all 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
2007-07-04 14:59:29 +04:00
setprecisions = map (transactionSetPrecision (lprecision l))
2007-07-09 22:54:41 +04:00
ledgerAccountTree :: Ledger -> Int -> Tree Account
ledgerAccountTree l depth =
addDataToAccountNameTree l $ treeprune depth $ accountnametree l
2007-07-03 12:46:39 +04:00
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
addDataToAccountNameTree = treemap . ledgerAccount
-- balance report support
--
-- examples: here is a sample account tree:
--
-- assets
-- cash
-- checking
-- saving
-- equity
-- expenses
-- food
-- shelter
-- income
-- salary
-- liabilities
-- debts
--
-- standard balance command shows all top-level accounts:
--
-- > ledger bal
-- $ assets
-- $ equity
-- $ expenses
-- $ income
-- $ liabilities
--
-- with an account pattern, show only the ones with matching names:
--
-- > ledger bal asset
-- $ assets
--
-- with -s, show all subaccounts of matched accounts:
--
-- > ledger -s bal asset
-- $ assets
-- $ cash
-- $ checking
-- $ saving
--
-- we elide boring accounts in two ways:
-- - leaf accounts and branches with 0 balance or 0 transactions are omitted
-- - inner accounts with 0 transactions and 1 subaccount are displayed inline
-- so this:
--
-- a (0 txns)
-- b (0 txns)
-- c
-- d
-- e (0 txns)
-- f
-- g
-- h (0 txns)
-- i (0 balance)
--
-- is displayed like:
--
-- a:b:c
-- d
-- e
-- f
-- g
2007-07-09 22:54:41 +04:00
showLedgerAccounts :: Ledger -> Int -> String
showLedgerAccounts l maxdepth =
concatMap
2007-07-03 12:46:39 +04:00
(showAccountTree l)
2007-07-09 22:54:41 +04:00
(branches $ ledgerAccountTree l maxdepth)
2007-07-03 03:41:07 +04:00
2007-07-03 12:46:39 +04:00
showAccountTree :: Ledger -> Tree Account -> String
showAccountTree l = showAccountTree' l 0 . pruneBoringBranches
2007-07-03 03:41:07 +04:00
2007-07-03 12:46:39 +04:00
showAccountTree' :: Ledger -> Int -> Tree Account -> String
showAccountTree' l indentlevel t
-- skip a boring inner account
| length subs > 0 && isBoringAccount l acct = subsindented 0
2007-07-03 03:41:07 +04:00
-- otherwise show normal indented account name with balance,
-- prefixing the names of any boring parents
| otherwise =
bal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subsindented 1)
2007-07-03 03:41:07 +04:00
where
acct = root t
subs = branches t
subsindented i = concatMap (showAccountTree' l (indentlevel+i)) subs
2007-07-03 03:41:07 +04:00
bal = printf "%20s" $ show $ abalance $ acct
indent = replicate (indentlevel * 2) ' '
prefix = concatMap (++ ":") $ map accountLeafName $ reverse boringparents
2007-07-03 12:46:39 +04:00
boringparents = takeWhile (isBoringAccountName l) $ parentAccountNames $ aname acct
2007-07-03 03:41:07 +04:00
leafname = accountLeafName $ aname acct
2007-07-03 12:46:39 +04:00
isBoringAccount :: Ledger -> Account -> Bool
isBoringAccount l a
2007-07-03 03:41:07 +04:00
| name == "top" = False
| (length txns == 0) && ((length subs) == 1) = True
| otherwise = False
where
name = aname a
txns = atransactions a
subs = subAccountNamesFrom (accountnames l) name
2007-07-03 12:46:39 +04:00
isBoringAccountName :: Ledger -> AccountName -> Bool
isBoringAccountName l = isBoringAccount l . ledgerAccount l
pruneBoringBranches :: Tree Account -> Tree Account
pruneBoringBranches =
2007-07-03 12:46:39 +04:00
treefilter hastxns . treefilter hasbalance
where
hasbalance = (/= 0) . abalance
hastxns = (> 0) . length . atransactions