begin optimization

Account.hs

@@ -12,14 +12,12 @@ import EntryTransaction
 import RawLedger
 
 
--- an Account caches an account's name, balance (including sub-accounts)
--- and transactions (excluding sub-accounts)
-
 instance Show Account where
     show (Account a ts b) = printf "Account %s with %d transactions" a $ length ts
 
 nullacct = Account "" [] nullamt
 
+-- XXX SLOW
 rawLedgerAccount :: RawLedger -> AccountName -> Account
 rawLedgerAccount l a = 
     Account 
@@ -133,6 +131,7 @@ rawLedgerAccountTreeMatching l acctpats showsubs maxdepth =
 showAccountTree :: RawLedger -> Tree Account -> String
 showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom
 
+showAccountTree' :: RawLedger -> Int -> Tree Account -> String
 showAccountTree' l indentlevel t
     -- if this acct is boring, don't show it
     | isBoringInnerAccount l acct = subacctsindented 0

AccountName.hs

@@ -3,9 +3,6 @@ where
 import Utils
 import Types
 
--- AccountNames are strings like "assets:cash:petty"; from these we build
--- the chart of accounts, which should be a simple hierarchy. 
-
 accountNameComponents :: AccountName -> [String]
 accountNameComponents = splitAtElement ':'
 
@@ -36,8 +33,10 @@ parentAccountNames a = parentAccountNames' $ parentAccountName a
       parentAccountNames' "" = []
       parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a)
 
+p `isAccountNamePrefixOf` s = ((p ++ ":") `isPrefixOf` s)
+    
 s `isSubAccountNameOf` p = 
-    ((p ++ ":") `isPrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))
+    (p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))
 
 subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName]
 subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts

Entry.hs

@@ -6,6 +6,8 @@ import Types
 import Transaction
 
 
+instance Show Entry where show = showEntry
+
 -- a register entry is displayed as two or more lines like this:
 -- date       description          account                 amount       balance
 -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
@@ -17,8 +19,6 @@ import Transaction
 -- amtWidth  = 11
 -- balWidth  = 12
 
-instance Show Entry where show = showEntry
-
 showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " "
 showDate d = printf "%-10s" d
 showDescription s = printf "%-20s" (elideRight 20 s)

EntryTransaction.hs

@@ -3,17 +3,13 @@ module EntryTransaction
 where
 import Utils
 import Types
+import AccountName
 import Entry
 import Transaction
 import Amount
 import Currency
 
 
--- We convert Transactions into EntryTransactions, which are (entry,
--- transaction) pairs, since I couldn't see how to have transactions
--- reference their entry like in OO.  These are referred to as just
--- "transactions" in code above.
-
 entry       (e,t) = e
 transaction (e,t) = t
 date        (e,t) = edate e
@@ -26,6 +22,9 @@ amount      (e,t) = tamount t
 flattenEntry :: Entry -> [EntryTransaction]
 flattenEntry e = [(e,t) | t <- etransactions e]
 
+accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
+accountNamesFromTransactions ts = nub $ map account ts
+
 entryTransactionsFrom :: [Entry] -> [EntryTransaction]
 entryTransactionsFrom es = concat $ map flattenEntry es
 
@@ -70,3 +69,19 @@ showTransactionAndBalance t b =
 showBalance :: Amount -> String
 showBalance b = printf " %12s" (showAmountRoundedOrZero b)
 
+transactionsMatching :: ([String],[String]) -> [EntryTransaction] -> [EntryTransaction]
+transactionsMatching ([],[]) ts = transactionsMatching ([".*"],[".*"]) ts
+transactionsMatching (rs,[]) ts = transactionsMatching (rs,[".*"]) ts
+transactionsMatching ([],rs) ts = transactionsMatching ([".*"],rs) ts
+transactionsMatching (acctregexps,descregexps) ts =
+    intersect 
+    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
+    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
+
+transactionsWithAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction]
+transactionsWithAccountName a ts = [t | t <- ts, account t == a]
+    
+transactionsWithOrBelowAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction]
+transactionsWithOrBelowAccountName a ts = 
+    [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)]
+    

Ledger.hs

@@ -1,6 +1,7 @@
 module Ledger
 where
 import qualified Data.Map as Map
+import Data.Map ((!))
 
 import Utils
 import Types
@@ -12,38 +13,98 @@ import RawLedger
 
 cacheLedger :: RawLedger -> Ledger
 cacheLedger l = 
-    Ledger 
+    let 
-    l
+        ant = rawLedgerAccountNameTree l
-    (rawLedgerAccountNameTree l)
+        ans = flatten ant
-    (Map.fromList [(a, rawLedgerAccount l a) | a <- rawLedgerAccountNames l])
+        ts = rawLedgerTransactions l
+        amap = Map.fromList [
+                (a,
+                 Account a
+                         (transactionsWithAccountName a ts)
+                         (sumEntryTransactions $ transactionsWithOrBelowAccountName a ts)
+                ) | a <- ans]
+    in
+          Ledger l ant amap
+
+ledgerAccount :: Ledger -> AccountName -> Account
+-- wtf  ledgerAccount l = ((accounts l) (!))
+ledgerAccount l aname = head [a | (n,a) <- Map.toList $ accounts l, n == aname]
 
 ledgerTransactions :: Ledger -> [EntryTransaction]
 ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
 
--- unoptimised
+-- XXX optimise
 ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
 ledgerTransactionsMatching pats l = rawLedgerTransactionsMatching pats $ rawledger l
 
--- XXX optimise
+-- XXX optimise (in progress)
-ledgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction]
-ledgerTransactionsMatching1 ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) (rawledger l)
-ledgerTransactionsMatching1 (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) (rawledger l)
-ledgerTransactionsMatching1 ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) (rawledger l)
-ledgerTransactionsMatching1 (acctregexps,descregexps) l =
-    intersect 
-    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
-    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
-    where ts = ledgerTransactions l
-
--- unoptimised
 showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
 showLedgerAccounts l acctpats showsubs maxdepth = 
-    showRawLedgerAccounts (rawledger l) acctpats showsubs maxdepth
-
--- XXX optimise
-showLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String
-showLedgerAccounts1 l acctpats showsubs maxdepth = 
     concatMap 
-    (showAccountTree (rawledger l)) 
+    (showAccountTree2 l) 
-    (branches (rawLedgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth))
+    (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))
+
+showAccountTree2 :: Ledger -> Tree Account -> String
+showAccountTree2 l = showAccountTree'2 l 0 . interestingAccountsFrom
+
+showAccountTree'2 :: Ledger -> Int -> Tree Account -> String
+showAccountTree'2 l indentlevel t
+    -- if this acct is boring, don't show it
+    | isBoringInnerAccount2 l acct = subacctsindented 0
+    -- otherwise show normal indented account name with balance, 
+    -- prefixing the names of any boring parents
+    | otherwise = 
+        bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subacctsindented 1)
+    where
+      acct = root t
+      subacctsindented i = concatMap (showAccountTree'2 l (indentlevel+i)) $ branches t
+      bal = printf "%20s" $ show $ abalance $ acct
+      indent = replicate (indentlevel * 2) ' '
+      prefix = concatMap (++ ":") $ map accountLeafName boringparents
+      boringparents = takeWhile (isBoringInnerAccountName2 l) $ parentAccountNames $ aname acct
+      leafname = accountLeafName $ aname acct
+
+isBoringInnerAccount2 :: Ledger -> Account -> Bool
+isBoringInnerAccount2 l a
+    | name == "top" = False
+    | (length txns == 0) && ((length subs) == 1) = True
+    | otherwise = False
+    where      
+      name = aname a
+      txns = atransactions a
+      subs = subAccountNamesFrom (accountnames l) name
+
+accountnames :: Ledger -> [AccountName]
+accountnames l = flatten $ accountnametree l
+
+isBoringInnerAccountName2 :: Ledger -> AccountName -> Bool
+isBoringInnerAccountName2 l name
+    | name == "top" = False
+    | (length txns == 0) && ((length subs) == 1) = True
+    | otherwise = False
+    where
+      txns = transactionsInAccountNamed2 l name
+      subs = subAccountNamesFrom (rawLedgerAccountNames (rawledger l)) name
+
+transactionsInAccountNamed2 :: Ledger -> AccountName -> [EntryTransaction]
+transactionsInAccountNamed2 l a = atransactions $ ledgerAccount l a
+
+----
+
+ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
+ledgerAccountTreeMatching l [] showsubs maxdepth = 
+    ledgerAccountTreeMatching l [".*"] showsubs maxdepth
+ledgerAccountTreeMatching l acctpats showsubs maxdepth = 
+    addDataToAccountNameTree2 l $ 
+    filterAccountNameTree acctpats showsubs maxdepth $ 
+    accountnametree l
+
+addDataToAccountNameTree2 :: Ledger -> Tree AccountName -> Tree Account
+addDataToAccountNameTree2 l ant = 
+    Node 
+    (ledgerAccount l $ root ant) 
+    (map (addDataToAccountNameTree2 l) $ branches ant)
+
+-- ledgerAccountNames :: Ledger -> [AccountName]
+-- ledgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
 

NOTES

@@ -10,11 +10,79 @@ hledger project notes
 *********** description                            EntryTransaction                    48   0.0    0.0     0.0    0.0
 ********** matchTransactionAccount                 EntryTransaction                    864  66.7    7.3    66.7    7.3
 *********** account                                EntryTransaction                    864   0.0    0.0     0.0    0.0
-    
+**** cachedledger added
-**** with cachedledger, unoptimised
       matchTransactionAccount EntryTransaction           619       86602  13.4    2.4    13.5    2.4
       matchTransactionAccount EntryTransaction           558       91637  22.8    2.8    22.9    2.8
       matchTransactionAccount EntryTransaction           520       91637  16.8    2.6    16.9    2.6
+**** functions renamed
+   balance               Main                                                 334           1   0.0    0.0    99.6   97.4
+    showLedgerAccounts   Ledger                                               460           1   0.0    0.0    99.6   97.3
+     showRawLedgerAccounts Account                                              461           1   0.1    0.0    99.6   97.3
+      showAccountTree    Account                                              505           1   0.0    0.0    31.6   37.3
+       showAccountTree'  Account                                              506          91   0.0    0.0    31.6   37.3
+        isBoringInnerAccountName Account                                              613          86   0.1    0.0    29.4   31.1
+         transactionsInAccountNamed Account                                              614          86   0.0    0.0    17.3    4.3
+          rawLedgerTransactionsMatching RawLedger                                            615         172   0.7    0.7    17.3    4.3
+           matchTransactionAccount EntryTransaction                                     619       86602  14.8    2.4    14.9    2.4
+>     rawLedgerAccountTreeMatching Account                                              463           2   0.0    0.0    67.9   60.0
+>      addDataToAccountNameTree Account                                              465          93   0.0    0.0    67.7   59.8
+>       rawLedgerAccount Account                                              512          92   0.0    0.0    67.7   59.8
+>        transactionsInAccountNamed Account                                              515          91   0.0    0.0    29.0   20.0
+>         rawLedgerTransactionsMatching RawLedger                                            516         182   3.6   13.9    29.0   20.0
+>          matchTransactionAccount EntryTransaction                                     520       91637  17.1    2.6    17.2    2.6
+         aggregateBalanceInAccountNamed Account                                              550          91   0.0    0.0    38.7   39.8
+          aggregateTransactionsInAccountNamed Account                                              553          91   0.0    0.0    38.7   39.8
+           rawLedgerTransactionsMatching RawLedger                                            554         182   7.3   32.8    38.7   39.7
+            matchTransactionAccount EntryTransaction                                     558       91637  22.6    2.8    22.8    2.8
+
+1
+showRawLedgerAccounts l acctpats showsubs maxdepth = 
+    concatMap 
+    (showAccountTree l) 
+    (branches (rawLedgerAccountTreeMatching l acctpats showsubs maxdepth))
+
+2
+rawLedgerAccountTreeMatching l [] showsubs maxdepth = 
+    rawLedgerAccountTreeMatching l [".*"] showsubs maxdepth
+rawLedgerAccountTreeMatching l acctpats showsubs maxdepth = 
+    addDataToAccountNameTree l $ 
+    filterAccountNameTree acctpats showsubs maxdepth $ 
+    rawLedgerAccountNameTree l
+
+93
+addDataToAccountNameTree l ant = 
+    Node 
+    (rawLedgerAccount l $ root ant) 
+    (map (addDataToAccountNameTree l) $ branches ant)
+
+92
+rawLedgerAccount l a = 
+    Account 
+    a 
+    (transactionsInAccountNamed l a) 
+    (aggregateBalanceInAccountNamed l a)
+
+91
+transactionsInAccountNamed l a =
+    rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l
+
+182
+rawLedgerTransactionsMatching ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) l
+rawLedgerTransactionsMatching (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) l
+rawLedgerTransactionsMatching ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) l
+rawLedgerTransactionsMatching (acctregexps,descregexps) l =
+    intersect 
+    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
+    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
+    where ts = rawLedgerTransactions l
+
+91637
+matchTransactionAccount s t =
+    case matchRegex (mkRegex s) (account t) of
+      Nothing -> False
+      otherwise -> True
+
+**** begin optimisation
 ** make some decent tests
 ** bugs
 *** space after account makes it a new account

RawLedger.hs

@@ -3,8 +3,8 @@ where
 import qualified Data.Map as Map
 
 import Utils
-import AccountName
 import Types
+import AccountName
 import Entry
 import EntryTransaction
 
@@ -31,9 +31,6 @@ rawLedgerTransactionsMatching (acctregexps,descregexps) l =
 rawLedgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction]
 rawLedgerAccountTransactions l a = rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l
            
-accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
-accountNamesFromTransactions ts = nub $ map account ts
-
 rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
 rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
 

Types.hs

@@ -114,7 +114,7 @@ data Account = Account {
 -- a ledger with account info cached for faster queries
 data Ledger = Ledger {
       rawledger :: RawLedger, 
-      accountnames :: Tree AccountName,
+      accountnametree :: Tree AccountName,
       accounts :: Map.Map AccountName Account
     }
 

Utils.hs

@@ -28,6 +28,7 @@ splitAtElement e l =
 
 -- tree tools
 
+-- aliases
 root = rootLabel
 branches = subForest