support --real/-R flag

This commit is contained in:
Simon Michael 2008-10-16 09:50:16 +00:00
parent 57603db7b9
commit 17ab6cb0ab
4 changed files with 20 additions and 7 deletions

View File

@ -14,6 +14,7 @@ import Ledger.AccountName
import Ledger.Amount import Ledger.Amount
import Ledger.Entry import Ledger.Entry
import Ledger.Transaction import Ledger.Transaction
import Ledger.RawTransaction
negativepatternchar = '-' negativepatternchar = '-'
@ -43,9 +44,10 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
-- | Remove ledger entries we are not interested in. -- | Remove ledger entries we are not interested in.
-- Keep only those which fall between the begin and end dates, and match -- Keep only those which fall between the begin and end dates, and match
-- the description pattern, and match the cleared flag. -- the description pattern, and are cleared or real if those options are active.
filterRawLedger :: String -> String -> [String] -> Bool -> RawLedger -> RawLedger filterRawLedger :: String -> String -> [String] -> Bool -> Bool -> RawLedger -> RawLedger
filterRawLedger begin end pats clearedonly = filterRawLedger begin end pats clearedonly realonly =
filterRawLedgerTransactionsByRealness realonly .
filterRawLedgerEntriesByClearedStatus clearedonly . filterRawLedgerEntriesByClearedStatus clearedonly .
filterRawLedgerEntriesByDate begin end . filterRawLedgerEntriesByDate begin end .
filterRawLedgerEntriesByDescription pats filterRawLedgerEntriesByDescription pats
@ -75,6 +77,14 @@ filterRawLedgerEntriesByClearedStatus False l = l
filterRawLedgerEntriesByClearedStatus True (RawLedger ms ps es f) = filterRawLedgerEntriesByClearedStatus True (RawLedger ms ps es f) =
RawLedger ms ps (filter estatus es) f RawLedger ms ps (filter estatus es) f
-- | Strip out any (virtual transactions), if the flag is true, otherwise
-- do no filtering.
filterRawLedgerTransactionsByRealness :: Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByRealness False l = l
filterRawLedgerTransactionsByRealness True (RawLedger ms ps es f) =
RawLedger ms ps (map filtertxns es) f
where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}
-- | Check if a set of ledger account/description patterns matches the -- | Check if a set of ledger account/description patterns matches the
-- given account name or entry description, applying ledger's special -- given account name or entry description, applying ledger's special
-- cases. -- cases.

View File

@ -25,7 +25,8 @@ options = [
Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input", Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input",
Option ['b'] ["begin"] (ReqArg Begin "YYYY/MM/DD") "report on entries on or after this date", Option ['b'] ["begin"] (ReqArg Begin "YYYY/MM/DD") "report on entries on or after this date",
Option ['e'] ["end"] (ReqArg End "YYYY/MM/DD") "report on entries prior to this date", Option ['e'] ["end"] (ReqArg End "YYYY/MM/DD") "report on entries prior to this date",
Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared transactions", Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared entries",
Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions",
Option ['s'] ["showsubs"] (NoArg ShowSubs) "in the balance report, include subaccounts", Option ['s'] ["showsubs"] (NoArg ShowSubs) "in the balance report, include subaccounts",
Option ['h'] ["help","usage"] (NoArg Help) "show this help", Option ['h'] ["help","usage"] (NoArg Help) "show this help",
Option ['V'] ["version"] (NoArg Version) "show version" Option ['V'] ["version"] (NoArg Version) "show version"
@ -37,6 +38,7 @@ data Opt =
Begin String | Begin String |
End String | End String |
Cleared | Cleared |
Real |
ShowSubs | ShowSubs |
Help | Help |
Version Version

View File

@ -21,7 +21,7 @@ rawledgerfromfile f = do
ledgerfromfile :: FilePath -> IO Ledger ledgerfromfile :: FilePath -> IO Ledger
ledgerfromfile f = do ledgerfromfile f = do
l <- rawledgerfromfile f l <- rawledgerfromfile f
return $ cacheLedger $ filterRawLedger "" "" [] False l return $ cacheLedger $ filterRawLedger "" "" [] False False l
-- | get a RawLedger from the file your LEDGER environment variable -- | get a RawLedger from the file your LEDGER environment variable
-- variable points to or (WARNING) an empty one if there was a problem. -- variable points to or (WARNING) an empty one if there was a problem.
@ -35,7 +35,7 @@ myrawledger = do
myledger :: IO Ledger myledger :: IO Ledger
myledger = do myledger = do
l <- myrawledger l <- myrawledger
return $ cacheLedger $ filterRawLedger "" "" [] False l return $ cacheLedger $ filterRawLedger "" "" [] False False l
-- | get a named account from your ledger file -- | get a named account from your ledger file
myaccount :: AccountName -> IO Account myaccount :: AccountName -> IO Account

View File

@ -70,9 +70,10 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ())
parseLedgerAndDo opts args cmd = parseLedgerAndDo opts args cmd =
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
where where
runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats cleared runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats cleared real
begin = beginDateFromOpts opts begin = beginDateFromOpts opts
end = endDateFromOpts opts end = endDateFromOpts opts
cleared = Cleared `elem` opts cleared = Cleared `elem` opts
real = Real `elem` opts
descpats = snd $ parseAccountDescriptionArgs args descpats = snd $ parseAccountDescriptionArgs args