diff --git a/AccountName.hs b/AccountName.hs index 93adeedb4..211fc1d3f 100644 --- a/AccountName.hs +++ b/AccountName.hs @@ -79,12 +79,3 @@ accountNameTreeFrom accts = accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as] subs = (subAccountNamesFrom accts) -filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName -filterAccountNameTree pats keepsubs maxdepth = - treefilter (\a -> matchany a || (keepsubs && issubofmatch a)) . treeprune maxdepth - where - regexes = map mkRegex pats - matchany a = any (match a) regexes - match a r = matchAccountName r $ accountLeafName a - issubofmatch a = any matchany $ parentAccountNames a - diff --git a/Ledger.hs b/Ledger.hs index 456fafc23..619d43729 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -43,11 +43,11 @@ cacheLedger acctpats descpats l = let (acctpats', descpats') = (wilddefault acctpats, wilddefault descpats) l' = filterLedgerEntries acctpats descpats l - ant = filterAccountNameTree acctpats' True 9999 $ rawLedgerAccountNameTree l' + ant = rawLedgerAccountNameTree l' ans = flatten ant filterTxnsByAcctpats ts = concat [filter (matchTransactionAccount $ mkRegex r) ts | r <- acctpats'] - allts = rawLedgerTransactions l' - ts = filterTxnsByAcctpats allts + allts = rawLedgerTransactions l + ts = rawLedgerTransactions l' sortedts = sortBy (comparing account) ts groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts tmap = Map.union @@ -64,8 +64,9 @@ cacheLedger acctpats descpats l = in Ledger l' ant amap lprecision -filterLedgerEntries :: [String] -> [String] -> LedgerFile -> LedgerFile -filterLedgerEntries acctpats descpats (LedgerFile ms ps es) = +-- filter entries by descpats and by whether any transactions contain any acctpats +filterLedgerEntries1 :: [String] -> [String] -> LedgerFile -> LedgerFile +filterLedgerEntries1 acctpats descpats (LedgerFile ms ps es) = LedgerFile ms ps es' where es' = intersect @@ -84,6 +85,29 @@ filterLedgerEntries acctpats descpats (LedgerFile ms ps es) = Nothing -> False otherwise -> True +-- filter txns in each entry by acctpats, then filter the modified entries by descpats +filterLedgerEntries :: [String] -> [String] -> LedgerFile -> LedgerFile +filterLedgerEntries acctpats descpats (LedgerFile ms ps es) = + LedgerFile ms ps es' + where + es' = filter matchanydesc $ map filtertxns es + acctregexps = map mkRegex $ wilddefault acctpats + descregexps = map mkRegex $ wilddefault descpats + filtertxns :: LedgerEntry -> LedgerEntry + filtertxns (LedgerEntry d s cod desc com ts) = LedgerEntry d s cod desc com $ filter matchanyacct ts + matchanyacct :: LedgerTransaction -> Bool + matchanyacct t = any (matchtxn t) acctregexps + matchtxn :: LedgerTransaction -> Regex -> Bool + matchtxn t r = case matchRegex r (taccount t) of + Nothing -> False + otherwise -> True + matchanydesc :: LedgerEntry -> Bool + matchanydesc e = any (matchdesc e) descregexps + matchdesc :: LedgerEntry -> Regex -> Bool + matchdesc e r = case matchRegex r (edescription e) of + Nothing -> False + otherwise -> True + accountnames :: Ledger -> [AccountName] accountnames l = flatten $ accountnametree l @@ -100,21 +124,9 @@ ledgerTransactions l = where setprecisions = map (transactionSetPrecision (lprecision l)) -ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction] -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 $ wilddefault acctpats - descregexps = map mkRegex $ wilddefault descpats - -ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account -ledgerAccountTreeMatching l acctpats showsubs maxdepth = - addDataToAccountNameTree l $ - filterAccountNameTree (wilddefault acctpats) showsubs maxdepth $ - accountnametree l +ledgerAccountTree :: Ledger -> Int -> Tree Account +ledgerAccountTree l depth = + addDataToAccountNameTree l $ treeprune depth $ accountnametree l addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account addDataToAccountNameTree = treemap . ledgerAccount @@ -181,11 +193,11 @@ addDataToAccountNameTree = treemap . ledgerAccount -- f -- g -showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String -showLedgerAccounts l acctpats showsubs maxdepth = +showLedgerAccounts :: Ledger -> Int -> String +showLedgerAccounts l maxdepth = concatMap (showAccountTree l) - (branches $ ledgerAccountTreeMatching l acctpats showsubs maxdepth) + (branches $ ledgerAccountTree l maxdepth) showAccountTree :: Ledger -> Tree Account -> String showAccountTree l = showAccountTree' l 0 . pruneBoringBranches diff --git a/Tests.hs b/Tests.hs index 17dcfd2ce..f4a944ddd 100644 --- a/Tests.hs +++ b/Tests.hs @@ -383,5 +383,5 @@ test_cacheLedger = assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger [] [] ledger7) test_showLedgerAccounts = - assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1) + assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1) diff --git a/hledger.hs b/hledger.hs index 071295d2f..64f4d639b 100644 --- a/hledger.hs +++ b/hledger.hs @@ -26,53 +26,14 @@ main = do run cmd opts acctpats descpats where run cmd opts acctpats descpats | Help `elem` opts = putStr usage - | cmd `isPrefixOf` "register" = register opts acctpats descpats - | cmd `isPrefixOf` "balance" = balance opts acctpats descpats + | cmd `isPrefixOf` "test" = test opts acctpats descpats | cmd `isPrefixOf` "print" = printcmd opts acctpats descpats - | cmd `isPrefixOf` "test" = test + | cmd `isPrefixOf` "register" = register opts acctpats descpats + | cmd `isPrefixOf` "balance" = balance opts acctpats descpats | otherwise = putStr usage --- commands - -test :: IO () -test = do - Tests.hunit - Tests.quickcheck - return () - -printcmd :: [Flag] -> [String] -> [String] -> IO () -printcmd opts acctpats descpats = do - doWithLedger opts acctpats descpats printentries - where - printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l - where - setprecision = map (entrySetPrecision (lprecision l)) - -register :: [Flag] -> [String] -> [String] -> IO () -register opts acctpats descpats = do - doWithLedger opts acctpats descpats printregister - where - printregister l = - putStr $ showTransactionsWithBalances - (sortBy (comparing date) (ledgerTransactionsMatching (acctpats, descpats) l)) - nullamt{precision=lprecision l} - -balance :: [Flag] -> [String] -> [String] -> IO () -balance opts acctpats descpats = do - doWithLedger opts acctpats descpats printbalance - where - printbalance l = - putStr $ showLedgerAccounts l acctpats showsubs maxdepth - where - showsubs = (ShowSubs `elem` opts) - maxdepth = case (acctpats, showsubs) of - ([],False) -> 1 - otherwise -> 9999 - --- utils - -doWithLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO () -doWithLedger opts acctpats descpats cmd = do +doWithFilteredLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO () +doWithFilteredLedger opts acctpats descpats cmd = do ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed acctpats descpats cmd doWithParsed :: [String] -> [String] -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () @@ -80,6 +41,42 @@ doWithParsed acctpats descpats cmd parsed = do case parsed of Left e -> parseError e Right l -> cmd $ cacheLedger acctpats descpats l +type Command = [Flag] -> [String] -> [String] -> IO () + +test :: Command +test opts acctpats descpats = do + Tests.hunit + Tests.quickcheck + return () + +printcmd :: Command +printcmd opts acctpats descpats = do + doWithFilteredLedger opts acctpats descpats printentries + where + printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l + where + setprecision = map (entrySetPrecision (lprecision l)) + +register :: Command +register opts acctpats descpats = do + doWithFilteredLedger opts acctpats descpats printregister + where + printregister l = + putStr $ showTransactionsWithBalances + (sortBy (comparing date) $ ledgerTransactions l) + nullamt{precision=lprecision l} + +balance :: Command +balance opts acctpats descpats = do + doWithFilteredLedger opts acctpats descpats printbalance + where + printbalance l = + putStr $ showLedgerAccounts l depth + where + showsubs = (ShowSubs `elem` opts) + depth = case (acctpats, showsubs) of + ([],False) -> 1 + otherwise -> 9999 {- interactive testing: