diff --git a/Ledger.hs b/Ledger.hs index 619d43729..deaa80a2b 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -38,15 +38,13 @@ instance Show Ledger where -- 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 = +cacheLedger :: ([Regex],[Regex]) -> LedgerFile -> Ledger +cacheLedger pats l = let - (acctpats', descpats') = (wilddefault acctpats, wilddefault descpats) - l' = filterLedgerEntries acctpats descpats l + lprecision = maximum $ map (precision . amount) $ rawLedgerTransactions l + l' = filterLedgerEntries pats l ant = rawLedgerAccountNameTree l' ans = flatten ant - filterTxnsByAcctpats ts = concat [filter (matchTransactionAccount $ mkRegex r) ts | r <- acctpats'] - allts = rawLedgerTransactions l ts = rawLedgerTransactions l' sortedts = sortBy (comparing account) ts groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts @@ -56,7 +54,6 @@ cacheLedger acctpats descpats l = txns = (tmap !) subaccts a = filter (isAccountNamePrefixOf a) ans subtxns a = concat [txns a | a <- [a] ++ subaccts a] - 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]) @@ -65,15 +62,13 @@ cacheLedger acctpats descpats l = Ledger l' ant amap lprecision -- filter entries by descpats and by whether any transactions contain any acctpats -filterLedgerEntries1 :: [String] -> [String] -> LedgerFile -> LedgerFile -filterLedgerEntries1 acctpats descpats (LedgerFile ms ps es) = +filterLedgerEntries1 :: ([Regex],[Regex]) -> LedgerFile -> LedgerFile +filterLedgerEntries1 (acctpats,descpats) (LedgerFile ms ps es) = LedgerFile ms ps es' where es' = intersect - (concat [filter (matchacct r) es | r <- acctregexps]) - (concat [filter (matchdesc r) es | r <- descregexps]) - acctregexps = map mkRegex $ wilddefault acctpats - descregexps = map mkRegex $ wilddefault descpats + (concat [filter (matchacct r) es | r <- acctpats]) + (concat [filter (matchdesc r) es | r <- descpats]) matchacct :: Regex -> LedgerEntry -> Bool matchacct r e = any (matchtxn r) (etransactions e) matchtxn :: Regex -> LedgerTransaction -> Bool @@ -86,23 +81,22 @@ filterLedgerEntries1 acctpats descpats (LedgerFile ms ps es) = 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) = +-- this seems aggressive, unbalancing entries, but so far so goo- +filterLedgerEntries :: ([Regex],[Regex]) -> 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 + matchanyacct t = any (matchtxn t) acctpats 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 + matchanydesc e = any (matchdesc e) descpats matchdesc :: LedgerEntry -> Regex -> Bool matchdesc e r = case matchRegex r (edescription e) of Nothing -> False diff --git a/Options.hs b/Options.hs index c9d265b96..46b27414f 100644 --- a/Options.hs +++ b/Options.hs @@ -73,8 +73,14 @@ tildeExpand xs = return xs -- ledger pattern args are 0 or more account patterns optionally followed -- by -- and 0 or more description patterns -parseLedgerPatternArgs :: [String] -> ([String],[String]) -parseLedgerPatternArgs args = - case "--" `elem` args of - True -> ((takeWhile (/= "--") args), tail $ (dropWhile (/= "--") args)) - False -> (args,[]) +parsePatternArgs :: [String] -> ([Regex],[Regex]) +parsePatternArgs args = argregexes acctpats descpats + where (acctpats, _:descpats) = break (=="--") args + +argregexes :: [String] -> [String] -> ([Regex],[Regex]) +argregexes as ds = (regexify as, regexify ds) + where + regexify = map mkRegex . wilddefault + wilddefault [] = [".*"] + wilddefault a = a + diff --git a/Tests.hs b/Tests.hs index f4a944ddd..f98cab954 100644 --- a/Tests.hs +++ b/Tests.hs @@ -283,7 +283,7 @@ ledger7 = LedgerFile } ] -l7 = cacheLedger [] [] ledger7 +l7 = cacheLedger (argregexes [] []) ledger7 timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n" timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger" @@ -306,14 +306,7 @@ quickcheck = mapM quickCheck ([ ] :: [Bool]) hunit = runTestTT $ "hunit" ~: test ([ - "" ~: parseLedgerPatternArgs [] @?= ([],[]) - ,"" ~: parseLedgerPatternArgs ["a"] @?= (["a"],[]) - ,"" ~: parseLedgerPatternArgs ["a","b"] @?= (["a","b"],[]) - ,"" ~: parseLedgerPatternArgs ["a","b","--"] @?= (["a","b"],[]) - ,"" ~: parseLedgerPatternArgs ["a","b","--","c","b"] @?= (["a","b"],["c","b"]) - ,"" ~: parseLedgerPatternArgs ["--","c"] @?= ([],["c"]) - ,"" ~: parseLedgerPatternArgs ["--"] @?= ([],[]) - ,"" ~: punctuatethousands "" @?= "" + "" ~: punctuatethousands "" @?= "" ,"" ~: punctuatethousands "1234567.8901" @?= "1,234,567.8901" ,"" ~: punctuatethousands "-100" @?= "-100" ,"" ~: test_ledgertransaction @@ -380,7 +373,7 @@ test_ledgerAccountNames = (rawLedgerAccountNames ledger7) test_cacheLedger = - assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger [] [] ledger7) + assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (argregexes [] []) ledger7) test_showLedgerAccounts = assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1) diff --git a/Utils.hs b/Utils.hs index a50cf7e8b..145131501 100644 --- a/Utils.hs +++ b/Utils.hs @@ -25,9 +25,6 @@ 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 64f4d639b..9b153a7dd 100644 --- a/hledger.hs +++ b/hledger.hs @@ -22,44 +22,44 @@ import Utils hiding (test) main :: IO () main = do (opts, (cmd:args)) <- getArgs >>= parseOptions - let (acctpats, descpats) = parseLedgerPatternArgs args - run cmd opts acctpats descpats - where run cmd opts acctpats descpats + let pats = parsePatternArgs args + run cmd opts pats + where run cmd opts pats | Help `elem` opts = putStr usage - | cmd `isPrefixOf` "test" = test opts acctpats descpats - | cmd `isPrefixOf` "print" = printcmd opts acctpats descpats - | cmd `isPrefixOf` "register" = register opts acctpats descpats - | cmd `isPrefixOf` "balance" = balance opts acctpats descpats + | cmd `isPrefixOf` "test" = test opts pats + | cmd `isPrefixOf` "print" = printcmd opts pats + | cmd `isPrefixOf` "register" = register opts pats + | cmd `isPrefixOf` "balance" = balance opts pats | otherwise = putStr usage -doWithFilteredLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO () -doWithFilteredLedger opts acctpats descpats cmd = do - ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed acctpats descpats cmd +doWithFilteredLedger :: [Flag] -> ([Regex],[Regex]) -> (Ledger -> IO ()) -> IO () +doWithFilteredLedger opts pats cmd = do + ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed pats cmd -doWithParsed :: [String] -> [String] -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () -doWithParsed acctpats descpats cmd parsed = do +doWithParsed :: ([Regex],[Regex]) -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () +doWithParsed pats cmd parsed = do case parsed of Left e -> parseError e - Right l -> cmd $ cacheLedger acctpats descpats l + Right l -> cmd $ cacheLedger pats l -type Command = [Flag] -> [String] -> [String] -> IO () +type Command = [Flag] -> ([Regex],[Regex]) -> IO () test :: Command -test opts acctpats descpats = do +test opts pats = do Tests.hunit Tests.quickcheck return () printcmd :: Command -printcmd opts acctpats descpats = do - doWithFilteredLedger opts acctpats descpats printentries +printcmd opts pats = do + doWithFilteredLedger opts pats 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 +register opts pats = do + doWithFilteredLedger opts pats printregister where printregister l = putStr $ showTransactionsWithBalances @@ -67,13 +67,14 @@ register opts acctpats descpats = do nullamt{precision=lprecision l} balance :: Command -balance opts acctpats descpats = do - doWithFilteredLedger opts acctpats descpats printbalance +balance opts pats = do + doWithFilteredLedger opts pats printbalance where printbalance l = putStr $ showLedgerAccounts l depth where showsubs = (ShowSubs `elem` opts) + (acctpats,_) = pats depth = case (acctpats, showsubs) of ([],False) -> 1 otherwise -> 9999