CachedLedger

CachedLedger.hs

@@ -0,0 +1,49 @@
+module CachedLedger
+where
+import qualified Data.Map as Map
+
+import Utils
+import Types
+import Account
+import AccountName
+import EntryTransaction
+import Ledger
+
+
+cacheLedger :: Ledger -> CachedLedger
+cacheLedger l = 
+    CachedLedger 
+    l
+    (ledgerAccountNameTree l)
+    (Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l])
+
+cLedgerTransactions :: CachedLedger -> [EntryTransaction]
+cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
+
+-- unoptimised
+cLedgerTransactionsMatching :: ([String],[String]) -> CachedLedger -> [EntryTransaction]
+cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ uncached_ledger l
+
+-- XXX optimise
+cLedgerTransactionsMatching1 :: ([String],[String]) -> CachedLedger -> [EntryTransaction]
+cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (uncached_ledger l)
+cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (uncached_ledger l)
+cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (uncached_ledger l)
+cLedgerTransactionsMatching1 (acctregexps,descregexps) l =
+    intersect 
+    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
+    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
+    where ts = cLedgerTransactions l
+
+-- unoptimised
+showCLedgerAccounts :: CachedLedger -> [String] -> Bool -> Int -> String
+showCLedgerAccounts l acctpats showsubs maxdepth = 
+    showLedgerAccounts (uncached_ledger l) acctpats showsubs maxdepth
+
+-- XXX optimise
+showCLedgerAccounts1 :: CachedLedger -> [String] -> Bool -> Int -> String
+showCLedgerAccounts1 l acctpats showsubs maxdepth = 
+    concatMap 
+    (showAccountTree (uncached_ledger l)) 
+    (branches (ledgerAccountTreeMatching (uncached_ledger l) acctpats showsubs maxdepth))
+

Models.hs

@@ -9,7 +9,8 @@ module Models (
                module TimeLog,
                module EntryTransaction,
                module Ledger,
-               module Account
+               module Account,
+               module CachedLedger,
               )
 where
 import qualified Data.Map as Map
@@ -24,4 +25,5 @@ import TimeLog
 import EntryTransaction
 import Ledger
 import Account
+import CachedLedger
 

NOTES

@@ -2,7 +2,8 @@ hledger project notes
 
 * TO DO
 ** make balance fast
-*** understand balance report execution, slowness, solution
+*** TODO optimise with CachedLedger
+**** original
 ******** transactionsInAccountNamed                Account                             12   0.0    0.1    66.7   18.7
 ********* ledgerTransactionsMatching               Ledger                              24   0.0    8.4    66.7   18.6
 ********** matchTransactionDescription             EntryTransaction                    48   0.0    0.7     0.0    0.7
@@ -10,9 +11,10 @@ hledger project notes
 ********** matchTransactionAccount                 EntryTransaction                    864  66.7    7.3    66.7    7.3
 *********** account                                EntryTransaction                    864   0.0    0.0     0.0    0.0
     
-*** make it fast
-**** TODO reorganize Ledger/Account
-**** substitute CookedLedger
+**** 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
 ** make some decent tests
 ** bugs
 *** space after account makes it a new account

Tests.hs

@@ -262,6 +262,7 @@ tests = runTestTT $ test [
         , test_autofillEntry
         , test_expandAccountNames
         , test_ledgerAccountNames
+        , test_cacheLedger
         , 2 @=? 2
         ]
 
@@ -289,6 +290,10 @@ test_ledgerAccountNames =
      "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
     (ledgerAccountNames ledger7)
 
+test_cacheLedger =
+    assertEqual' 14 (length $ Map.keys $ accounts $ cacheLedger ledger7)
+    
+
 -- quickcheck properties
 
 props = mapM quickCheck

Types.hs

@@ -1,6 +1,7 @@
-module Types
+module Types 
 where
 import Utils
+import qualified Data.Map as Map
 
 {-
 
@@ -16,16 +17,17 @@ hledger
    Models
     TimeLog
      TimeLogEntry
-    Account
-     Ledger
-      EntryTransaction
-       Entry
-        Transaction
-         AccountName
-         Amount
-          Currency
-           Types
-            Utils
+    CachedLedger
+     Account
+      Ledger
+       EntryTransaction
+        Entry
+         Transaction
+          AccountName
+          Amount
+           Currency
+            Types
+             Utils
 
 -}
 
@@ -78,14 +80,7 @@ data PeriodicEntry = PeriodicEntry {
       p_transactions :: [Transaction]
     } deriving (Eq)
 
--- a parsed ledger file
-data Ledger = Ledger {
-      modifier_entries :: [ModifierEntry],
-      periodic_entries :: [PeriodicEntry],
-      entries :: [Entry]
-    } deriving (Eq)
-
--- we also process timeclock.el's timelogs
+-- we also parse timeclock.el's timelogs (as a ledger)
 data TimeLogEntry = TimeLogEntry {
       tcode :: Char,
       tdatetime :: DateTime,
@@ -96,17 +91,30 @@ data TimeLog = TimeLog {
       timelog_entries :: [TimeLogEntry]
     } deriving (Eq)
 
+-- a parsed ledger file
+data Ledger = Ledger {
+      modifier_entries :: [ModifierEntry],
+      periodic_entries :: [PeriodicEntry],
+      entries :: [Entry]
+    } deriving (Eq)
+
 -- 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 modules above EntryTransaction.
 type EntryTransaction = (Entry,Transaction)
 
--- an Account caches a particular account's name, balance and transactions
--- from a Ledger
+-- all information for a particular account, derived from a Ledger
 data Account = Account {
       aname :: AccountName, 
       atransactions :: [EntryTransaction], -- excludes sub-accounts
       abalance :: Amount                   -- includes sub-accounts
     }
 
+-- a ledger with account info cached for faster queries
+data CachedLedger = CachedLedger {
+      uncached_ledger :: Ledger, 
+      accountnames :: Tree AccountName,
+      accounts :: Map.Map AccountName Account
+    }
+

hledger.hs

@@ -37,17 +37,17 @@ register :: [Flag] -> [String] -> [String] -> IO ()
 register opts acctpats descpats = do 
   doWithLedger opts printRegister
     where 
-      printRegister ledger = 
+      printRegister l = 
           putStr $ showTransactionsWithBalances 
-                     (ledgerTransactionsMatching (acctpats,descpats) ledger)
+                     (cLedgerTransactionsMatching (acctpats,descpats) l)
                      0
 
 balance :: [Flag] -> [String] -> [String] -> IO ()
 balance opts acctpats _ = do 
   doWithLedger opts printBalance
     where
-      printBalance ledger =
-          putStr $ showLedgerAccounts ledger acctpats showsubs maxdepth
+      printBalance l =
+          putStr $ showCLedgerAccounts l acctpats showsubs maxdepth
               where 
                 showsubs = (ShowSubs `elem` opts)
                 maxdepth = case (acctpats, showsubs) of
@@ -63,14 +63,14 @@ selftest = do
 
 -- utils
 
-doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
+doWithLedger :: [Flag] -> (CachedLedger -> IO ()) -> IO ()
 doWithLedger opts cmd = do
     ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
 
-doWithParsed :: Show a => (a -> IO ()) -> (Either ParseError a) -> IO ()
-doWithParsed action parsed = do
+doWithParsed :: (CachedLedger -> IO ()) -> (Either ParseError Ledger) -> IO ()
+doWithParsed cmd parsed = do
   case parsed of Left e -> parseError e
-                 Right l -> action l
+                 Right l -> cmd $ cacheLedger l
 
 -- interactive testing:
 --