From ec1b5b9bceedcdb4b417d457b40ee56fa59b8270 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 7 Jul 2007 18:26:28 +0000 Subject: [PATCH] balance: combine boring account names properly when matching account patterns --- Ledger.hs | 30 ++++++++++++++++-------------- Tests.hs | 4 ++-- Transaction.hs | 4 ++++ Utils.hs | 3 +++ hledger.hs | 24 ++++++++++++------------ 5 files changed, 37 insertions(+), 28 deletions(-) diff --git a/Ledger.hs b/Ledger.hs index 58a1aebea..aca86c4b9 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -34,14 +34,19 @@ instance Show Ledger where (length $ periodic_entries $ rawledger l)) (length $ accountnames l) --- at startup, we augment the parsed ledger entries with an account map --- and other things useful for performance -cacheLedger :: LedgerFile -> Ledger -cacheLedger l = +-- at startup, to improve performance, we refine the parsed ledger entries: +-- 1. filter based on account/description patterns, if any +-- 2. cache per-account info +-- also, figure out the precision(s) to use +cacheLedger :: [String] -> [String] -> LedgerFile -> Ledger +cacheLedger acctpats descpats l = let - ant = rawLedgerAccountNameTree l + (acctpats', descpats') = (wilddefault acctpats, wilddefault descpats) + ant = filterAccountNameTree acctpats' True 9999 $ rawLedgerAccountNameTree l ans = flatten ant - ts = rawLedgerTransactions l + filterTxnsByAcctpats ts = concat [filter (matchTransactionAccount $ mkRegex r) ts | r <- acctpats'] + allts = rawLedgerTransactions l + ts = filterTxnsByAcctpats allts sortedts = sortBy (comparing account) ts groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts tmap = Map.union @@ -50,7 +55,7 @@ cacheLedger l = txns = (tmap !) subaccts a = filter (isAccountNamePrefixOf a) ans subtxns a = concat [txns a | a <- [a] ++ subaccts a] - lprecision = maximum $ map (precision . amount) ts + lprecision = maximum $ map (precision . amount) allts bmap = Map.union (Map.fromList [(a, (sumTransactions $ subtxns a){precision=lprecision}) | a <- ans]) (Map.fromList [(a,nullamt) | a <- ans]) @@ -75,17 +80,14 @@ ledgerTransactions l = setprecisions = map (transactionSetPrecision (lprecision l)) ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction] -ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l -ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l -ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l ledgerTransactionsMatching (acctpats,descpats) l = intersect (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) where ts = ledgerTransactions l - acctregexps = map mkRegex acctpats - descregexps = map mkRegex descpats + acctregexps = map mkRegex $ wilddefault acctpats + descregexps = map mkRegex $ wilddefault descpats ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account ledgerAccountTreeMatching l [] showsubs maxdepth = @@ -164,7 +166,7 @@ showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String showLedgerAccounts l acctpats showsubs maxdepth = concatMap (showAccountTree l) - (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) + (branches $ ledgerAccountTreeMatching l acctpats showsubs maxdepth) showAccountTree :: Ledger -> Tree Account -> String showAccountTree l = showAccountTree' l 0 . pruneBoringBranches @@ -183,7 +185,7 @@ showAccountTree' l indentlevel t subsindented i = concatMap (showAccountTree' l (indentlevel+i)) subs bal = printf "%20s" $ show $ abalance $ acct indent = replicate (indentlevel * 2) ' ' - prefix = concatMap (++ ":") $ map accountLeafName boringparents + prefix = concatMap (++ ":") $ map accountLeafName $ reverse boringparents boringparents = takeWhile (isBoringAccountName l) $ parentAccountNames $ aname acct leafname = accountLeafName $ aname acct diff --git a/Tests.hs b/Tests.hs index b4dd03bb1..17dcfd2ce 100644 --- a/Tests.hs +++ b/Tests.hs @@ -283,7 +283,7 @@ ledger7 = LedgerFile } ] -l7 = cacheLedger ledger7 +l7 = cacheLedger [] [] ledger7 timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n" timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger" @@ -380,7 +380,7 @@ test_ledgerAccountNames = (rawLedgerAccountNames ledger7) test_cacheLedger = - assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger ledger7) + assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger [] [] ledger7) test_showLedgerAccounts = assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1) diff --git a/Transaction.hs b/Transaction.hs index 5d062c98f..1bc870cb8 100644 --- a/Transaction.hs +++ b/Transaction.hs @@ -9,6 +9,10 @@ import Amount import Currency +instance Show Transaction where + show (Transaction eno d desc a amt) = + unwords [d,desc,a,show amt] + -- we use the entry number e to remember the grouping of txns flattenEntry :: (LedgerEntry, Int) -> [Transaction] flattenEntry (LedgerEntry d _ _ desc _ ts, e) = diff --git a/Utils.hs b/Utils.hs index 145131501..a50cf7e8b 100644 --- a/Utils.hs +++ b/Utils.hs @@ -25,6 +25,9 @@ import Test.QuickCheck hiding (test, Testable) import Test.HUnit +wilddefault [] = [".*"] +wilddefault a = a + -- lists splitAtElement :: Eq a => a -> [a] -> [[a]] diff --git a/hledger.hs b/hledger.hs index 94c1f00dd..274aaa007 100644 --- a/hledger.hs +++ b/hledger.hs @@ -42,24 +42,24 @@ test = do register :: [Flag] -> [String] -> [String] -> IO () register opts acctpats descpats = do - doWithLedger opts printregister + doWithLedger opts acctpats descpats printregister where printregister l = putStr $ showTransactionsWithBalances - (sortBy (comparing date) (ledgerTransactionsMatching (acctpats,descpats) l)) + (sortBy (comparing date) (ledgerTransactionsMatching (acctpats, descpats) l)) nullamt{precision=lprecision l} -printcmd :: [Flag] -> IO () +printcmd :: [Flag] -> IO () -- XXX acctpats descpats ? printcmd opts = do - doWithLedger opts printentries + doWithLedger opts [] [] printentries where printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l where setprecision = map (entrySetPrecision (lprecision l)) balance :: [Flag] -> [String] -> [String] -> IO () -balance opts acctpats _ = do - doWithLedger opts printbalance +balance opts acctpats _ = do -- XXX descpats + doWithLedger opts acctpats [] printbalance where printbalance l = putStr $ showLedgerAccounts l acctpats showsubs maxdepth @@ -71,14 +71,14 @@ balance opts acctpats _ = do -- utils -doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO () -doWithLedger opts cmd = do - ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd +doWithLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO () +doWithLedger opts acctpats descpats cmd = do + ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed acctpats descpats cmd -doWithParsed :: (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () -doWithParsed cmd parsed = do +doWithParsed :: [String] -> [String] -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () +doWithParsed acctpats descpats cmd parsed = do case parsed of Left e -> parseError e - Right l -> cmd $ cacheLedger l + Right l -> cmd $ cacheLedger acctpats descpats l {-