--uncleared option

This commit is contained in:
Simon Michael 2009-04-03 11:45:56 +00:00
parent 0f1cbef9a8
commit ab94a6e9a2
4 changed files with 42 additions and 10 deletions

View File

@ -69,7 +69,7 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
-- | Remove ledger transactions we are not interested in. -- | Remove ledger transactions 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 are cleared or real if those options are active. -- the description pattern, and are cleared or real if those options are active.
filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger filterRawLedger :: DateSpan -> [String] -> Maybe Bool -> Bool -> RawLedger -> RawLedger
filterRawLedger span pats clearedonly realonly = filterRawLedger span pats clearedonly realonly =
filterRawLedgerPostingsByRealness realonly . filterRawLedgerPostingsByRealness realonly .
filterRawLedgerTransactionsByClearedStatus clearedonly . filterRawLedgerTransactionsByClearedStatus clearedonly .
@ -91,12 +91,12 @@ filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls h
where where
matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end) matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end)
-- | Keep only ledger transactions with cleared status, if the flag is true, otherwise -- | Keep only ledger transactions which have the requested
-- do no filtering. -- cleared/uncleared status, if there is one.
filterRawLedgerTransactionsByClearedStatus :: Bool -> RawLedger -> RawLedger filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByClearedStatus False l = l filterRawLedgerTransactionsByClearedStatus Nothing rl = rl
filterRawLedgerTransactionsByClearedStatus True (RawLedger ms ps ts tls hs f) = filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f) =
RawLedger ms ps (filter ltstatus ts) tls hs f RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f
-- | Strip out any virtual postings, if the flag is true, otherwise do -- | Strip out any virtual postings, if the flag is true, otherwise do
-- no filtering. -- no filtering.

View File

@ -62,6 +62,7 @@ options = [
,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++ ,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++
"and/or with the specified reporting interval\n") "and/or with the specified reporting interval\n")
,Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared transactions" ,Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared transactions"
,Option ['U'] ["uncleared"] (NoArg UnCleared) "report only on uncleared transactions"
,Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost of commodities" ,Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost of commodities"
,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this" ,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this"
,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching simple EXPR\n" ++ ,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching simple EXPR\n" ++
@ -92,6 +93,7 @@ data Opt =
End {value::String} | End {value::String} |
Period {value::String} | Period {value::String} |
Cleared | Cleared |
UnCleared |
CostBasis | CostBasis |
Depth {value::String} | Depth {value::String} |
Display {value::String} | Display {value::String} |
@ -109,10 +111,13 @@ data Opt =
| DebugNoUI | DebugNoUI
deriving (Show,Eq) deriving (Show,Eq)
-- yow.. -- these make me nervous
optsWithConstructor f opts = concatMap get opts optsWithConstructor f opts = concatMap get opts
where get o = if f v == o then [o] else [] where v = value o where get o = if f v == o then [o] else [] where v = value o
optsWithConstructors fs opts = concatMap get opts
where get o = if any (\f -> f == o) fs then [o] else []
optValuesForConstructor f opts = concatMap get opts optValuesForConstructor f opts = concatMap get opts
where get o = if f v == o then [v] else [] where v = value o where get o = if f v == o then [v] else [] where v = value o

View File

@ -328,7 +328,7 @@ tests = [
,"" ,""
] ]
let l = cacheLedger [] $ let l = cacheLedger [] $
filterRawLedger (DateSpan Nothing Nothing) [] False False $ filterRawLedger (DateSpan Nothing Nothing) [] Nothing False $
canonicaliseAmounts True rl -- enable cost basis adjustment canonicaliseAmounts True rl -- enable cost basis adjustment
showBalanceReport [] [] l `is` showBalanceReport [] [] l `is`
unlines unlines
@ -537,6 +537,29 @@ tests = [
," assets:bank:checking $-1 0" ," assets:bank:checking $-1 0"
] ]
,"register report with cleared arg" ~:
do
l <- ledgerfromstringwithopts [Cleared] [] sampletime sample_ledger_str
showRegisterReport [Cleared] [] l `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2"
," assets:cash $-2 0"
,"2008/12/31 pay off liabilities:debts $1 $1"
," assets:bank:checking $-1 0"
]
,"register report with uncleared arg" ~:
do
l <- ledgerfromstringwithopts [UnCleared] [] sampletime sample_ledger_str
showRegisterReport [UnCleared] [] l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1"
," income:gifts $-1 0"
,"2008/06/02 save assets:bank:saving $1 $1"
," assets:bank:checking $-1 0"
]
,"register report sorts by date" ~: ,"register report sorts by date" ~:
do do
l <- ledgerfromstringwithopts [] [] sampletime $ unlines l <- ledgerfromstringwithopts [] [] sampletime $ unlines

View File

@ -23,9 +23,13 @@ prepareLedger opts args reftime rawtext rl = l{rawledgertext=rawtext}
l = cacheLedger apats $ filterRawLedger span dpats c r $ canonicaliseAmounts cb rl l = cacheLedger apats $ filterRawLedger span dpats c r $ canonicaliseAmounts cb rl
(apats,dpats) = parseAccountDescriptionArgs [] args (apats,dpats) = parseAccountDescriptionArgs [] args
span = dateSpanFromOpts (localDay reftime) opts span = dateSpanFromOpts (localDay reftime) opts
c = Cleared `elem` opts
r = Real `elem` opts r = Real `elem` opts
cb = CostBasis `elem` opts cb = CostBasis `elem` opts
c = clearedValueFromOpts opts
where clearedValueFromOpts opts | null os = Nothing
| last os == Cleared = Just True
| otherwise = Just False
where os = optsWithConstructors [Cleared,UnCleared] opts
-- | Get a RawLedger from the given string, or raise an error. -- | Get a RawLedger from the given string, or raise an error.
-- This uses the current local time as the reference time (for closing -- This uses the current local time as the reference time (for closing