code cleanups

This commit is contained in:
Simon Michael 2008-10-18 00:52:49 +00:00
parent db8b00d6e5
commit f865ab1c1c
3 changed files with 36 additions and 58 deletions

View File

@ -1,7 +1,7 @@
{-|
An 'Account' stores an account name, all transactions in the account
(excluding any subaccounts), and the total balance (including any
An 'Account' stores, for efficiency: an 'AccountName', all transactions in
the account (excluding subaccounts), and the account balance (including
subaccounts).
-}
@ -16,5 +16,8 @@ import Ledger.Amount
instance Show Account where
show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (showMixedAmount b)
instance Eq Account where
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
nullacct = Account "" [] []

View File

@ -1,8 +1,8 @@
{-|
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of
account names, a map from account names to 'Account's. Typically it
also has had uninteresting 'Entry's filtered out.
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
names, and a map from account names to 'Account's. Typically it also has
had uninteresting 'Entry's filtered out.
-}
@ -14,6 +14,7 @@ import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.AccountName
import Ledger.Account
import Ledger.Transaction
import Ledger.RawLedger
import Ledger.Entry
@ -29,27 +30,25 @@ instance Show Ledger where
-- | Convert a raw ledger to a more efficient cached type, described above.
cacheLedger :: RawLedger -> Ledger
cacheLedger 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
cacheLedger l = Ledger l ant amap
where
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 (a `isAccountNamePrefixOf`) anames
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
balmap = Map.union
txnsof = (txnmap !)
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
balmap = Map.union
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
(Map.fromList [(a,[]) | a <- anames])
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
in
Ledger l ant amap
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
-- | List a 'Ledger' 's account names.
-- | List a ledger's account names.
accountnames :: Ledger -> [AccountName]
accountnames l = drop 1 $ flatten $ accountnametree l
@ -73,11 +72,8 @@ accountsMatching pats l = filter (matchLedgerPatterns True pats . aname) $ accou
-- | List a ledger account's immediate subaccounts
subAccounts :: Ledger -> Account -> [Account]
subAccounts l a = map (ledgerAccount l) subacctnames
where
allnames = accountnames l
name = aname a
subacctnames = filter (name `isAccountNamePrefixOf`) allnames
subAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (a `isAccountNamePrefixOf`) $ accountnames l
-- | List a ledger's transactions.
ledgerTransactions :: Ledger -> [Transaction]
@ -85,22 +81,8 @@ ledgerTransactions l = rawLedgerTransactions $ rawledger 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 = accountnametree l
depthpruned = treeprune depth nametree
-- that's weird.. why can't this be in Account.hs ?
instance Eq Account where
(==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2
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
-- | Convert a tree of account names into a tree of accounts, using their
-- parent ledger.
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
addDataToAccountNameTree = treemap . ledgerAccount

View File

@ -29,10 +29,8 @@ instance Show RawLedger where
where accounts = flatten $ rawLedgerAccountNameTree l
rawLedgerTransactions :: RawLedger -> [Transaction]
rawLedgerTransactions = txns . entries
where
txns :: [Entry] -> [Transaction]
txns es = concat $ map flattenEntry $ zip es (iterate (+1) 1)
rawLedgerTransactions = txnsof . entries
where txnsof es = concat $ map flattenEntry $ zip es [1..]
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
@ -55,9 +53,7 @@ filterRawLedger begin end pats =
filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
RawLedger ms ps (filter matchdesc es) f
where
matchdesc :: Entry -> Bool
matchdesc = matchLedgerPatterns False pats . edescription
where matchdesc = matchLedgerPatterns False pats . edescription
-- | Keep only entries which fall between begin and end dates.
-- We include entries on the begin date and exclude entries on the end
@ -65,14 +61,11 @@ filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
filterRawLedgerEntriesByDate :: String -> String -> RawLedger -> RawLedger
filterRawLedgerEntriesByDate 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
where
d1 = parsedate begin :: UTCTime
d2 = parsedate end
matchdate e = (null begin || d >= d1) && (null end || d < d2)
where d = parsedate $ edate e
-- | Check if a set of ledger account/description patterns matches the
@ -86,14 +79,14 @@ filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =
-- matches only the leaf name.
matchLedgerPatterns :: Bool -> [String] -> String -> Bool
matchLedgerPatterns forbalancereport pats str =
(null positives || any ismatch positives) && (null negatives || (not $ any ismatch negatives))
(null positives || any ismatch positives) && (null negatives || not (any ismatch negatives))
where
isnegative = (== negativepatternchar) . head
(negatives,positives) = partition isnegative pats
ismatch pat = containsRegex (mkRegexWithOpts pat' True True) matchee
where
pat' = if isnegative pat then drop 1 pat else pat
matchee = if forbalancereport && (not $ ':' `elem` pat) && (not $ isnegative pat)
matchee = if forbalancereport && not (':' `elem` pat) && not (isnegative pat)
then accountLeafName str
else str