From ab94a6e9a2c1ef71400aec60b9af8d1f69121c2e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 3 Apr 2009 11:45:56 +0000 Subject: [PATCH] --uncleared option --- Ledger/RawLedger.hs | 14 +++++++------- Options.hs | 7 ++++++- Tests.hs | 25 ++++++++++++++++++++++++- Utils.hs | 6 +++++- 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index a57d13e94..2a9412dbb 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -69,7 +69,7 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l -- | Remove ledger transactions we are not interested in. -- 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. -filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger +filterRawLedger :: DateSpan -> [String] -> Maybe Bool -> Bool -> RawLedger -> RawLedger filterRawLedger span pats clearedonly realonly = filterRawLedgerPostingsByRealness realonly . filterRawLedgerTransactionsByClearedStatus clearedonly . @@ -91,12 +91,12 @@ filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls h where 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 --- do no filtering. -filterRawLedgerTransactionsByClearedStatus :: Bool -> RawLedger -> RawLedger -filterRawLedgerTransactionsByClearedStatus False l = l -filterRawLedgerTransactionsByClearedStatus True (RawLedger ms ps ts tls hs f) = - RawLedger ms ps (filter ltstatus ts) tls hs f +-- | Keep only ledger transactions which have the requested +-- cleared/uncleared status, if there is one. +filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger +filterRawLedgerTransactionsByClearedStatus Nothing rl = rl +filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps 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 -- no filtering. diff --git a/Options.hs b/Options.hs index 2e0f5c80b..239bd0109 100644 --- a/Options.hs +++ b/Options.hs @@ -62,6 +62,7 @@ options = [ ,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++ "and/or with the specified reporting interval\n") ,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 [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this" ,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching simple EXPR\n" ++ @@ -92,6 +93,7 @@ data Opt = End {value::String} | Period {value::String} | Cleared | + UnCleared | CostBasis | Depth {value::String} | Display {value::String} | @@ -109,10 +111,13 @@ data Opt = | DebugNoUI deriving (Show,Eq) --- yow.. +-- these make me nervous optsWithConstructor f opts = concatMap get opts 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 where get o = if f v == o then [v] else [] where v = value o diff --git a/Tests.hs b/Tests.hs index 5bc22139d..454818fcc 100644 --- a/Tests.hs +++ b/Tests.hs @@ -328,7 +328,7 @@ tests = [ ,"" ] let l = cacheLedger [] $ - filterRawLedger (DateSpan Nothing Nothing) [] False False $ + filterRawLedger (DateSpan Nothing Nothing) [] Nothing False $ canonicaliseAmounts True rl -- enable cost basis adjustment showBalanceReport [] [] l `is` unlines @@ -537,6 +537,29 @@ tests = [ ," 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" ~: do l <- ledgerfromstringwithopts [] [] sampletime $ unlines diff --git a/Utils.hs b/Utils.hs index 45df7c092..a035b677c 100644 --- a/Utils.hs +++ b/Utils.hs @@ -23,9 +23,13 @@ prepareLedger opts args reftime rawtext rl = l{rawledgertext=rawtext} l = cacheLedger apats $ filterRawLedger span dpats c r $ canonicaliseAmounts cb rl (apats,dpats) = parseAccountDescriptionArgs [] args span = dateSpanFromOpts (localDay reftime) opts - c = Cleared `elem` opts r = Real `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. -- This uses the current local time as the reference time (for closing