From f865ab1c1cf6bc0edf8cb274a877cf5f691df524 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 18 Oct 2008 00:52:49 +0000 Subject: [PATCH] code cleanups --- Ledger/Account.hs | 7 ++++-- Ledger/Ledger.hs | 60 ++++++++++++++++----------------------------- Ledger/RawLedger.hs | 27 ++++++++------------ 3 files changed, 36 insertions(+), 58 deletions(-) diff --git a/Ledger/Account.hs b/Ledger/Account.hs index 3e78a49be..f5b7d5dd0 100644 --- a/Ledger/Account.hs +++ b/Ledger/Account.hs @@ -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 "" [] [] diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 3c6d0309c..cb4c155df 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -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 - diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 9f999e1fe..1c6c4c753 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -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