diff --git a/CachedLedger.hs b/CachedLedger.hs new file mode 100644 index 000000000..3fb87449f --- /dev/null +++ b/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)) + diff --git a/Models.hs b/Models.hs index f9a83844e..255f0a1d3 100644 --- a/Models.hs +++ b/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 diff --git a/NOTES b/NOTES index 23de9e6fb..1995743a2 100644 --- a/NOTES +++ b/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 diff --git a/Tests.hs b/Tests.hs index 67fbe00ac..d39a8cf4d 100644 --- a/Tests.hs +++ b/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 diff --git a/Types.hs b/Types.hs index 8feabbfef..c7cf38c23 100644 --- a/Types.hs +++ b/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 + } + diff --git a/hledger.hs b/hledger.hs index 83214faa9..c73ad6fbf 100644 --- a/hledger.hs +++ b/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: --