simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-16 16:57:38 +03:00
Code Issues Projects Releases Wiki Activity

clean up account/description pattern handling

Browse Source
This commit is contained in:
Simon Michael 2007-07-11 05:46:20 +00:00
parent 2b608a6c9c
commit ce0d4ec85a
5 changed files with 49 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
Ledger.hs
View File

@ -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

16
Options.hs
View File

@ -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

13
Tests.hs
View File

@ -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)

3
Utils.hs
View File

@ -25,9 +25,6 @@ import Test.QuickCheck hiding (test, Testable)
import Test.HUnit
wilddefault [] = [".*"]
wilddefault a = a
-- lists
splitAtElement :: Eq a => a -> [a] -> [[a]]

43
hledger.hs
View File

@ -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