balance, register now filter more strongly by sym:

This commit is contained in:
Simon Michael 2014-02-27 17:47:47 -08:00
parent 73c09f91d7
commit 46d594bada
4 changed files with 86 additions and 24 deletions

View File

@ -19,8 +19,10 @@ module Hledger.Data.Journal (
journalConvertAmountsToCost,
journalFinalise,
-- * Filtering
filterJournalPostings,
filterJournalTransactions,
filterJournalPostings,
filterJournalPostingAmounts,
filterPostingAmount,
-- * Querying
journalAccountNames,
journalAccountNamesUsed,
@ -28,6 +30,7 @@ module Hledger.Data.Journal (
journalAmounts,
-- journalCanonicalCommodities,
journalDateSpan,
journalDescriptions,
journalFilePath,
journalFilePaths,
journalPostings,
@ -153,13 +156,19 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
-- | Unique transaction descriptions used in this journal.
journalDescriptions :: Journal -> [String]
journalDescriptions = nub . sort . map tdescription . jtxns
-- | All postings from this journal's transactions, in order.
journalPostings :: Journal -> [Posting]
journalPostings = concatMap tpostings . jtxns
-- | All account names used in this journal.
-- | Unique account names posted to in this journal.
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings
-- | Unique account names in this journal, including parent accounts containing no postings.
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
@ -228,6 +237,17 @@ filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionposti
where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}
-- Within each posting's amount, keep only the parts matching the query.
-- This can leave unbalanced transactions.
filterJournalPostingAmounts :: Query -> Journal -> Journal
filterJournalPostingAmounts q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts}
where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=map (filterPostingAmount q) ps}
-- | Filter out all parts of this posting's amount which do not match the query.
filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as}
-- | Keep only transactions matching the query expression.
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts}

View File

@ -19,6 +19,7 @@ import Hledger.Data.Account
import Hledger.Data.Journal
import Hledger.Data.Posting
import Hledger.Query
import Hledger.Utils
instance Show Ledger where
@ -35,15 +36,18 @@ nullledger = Ledger {
laccounts = []
}
-- | Filter a journal's transactions with the given query, then derive a
-- ledger containing the chart of accounts and balances. If the query
-- includes a depth limit, that will affect the ledger's journal but not
-- the account tree.
-- | Filter a journal's transactions with the given query, then derive
-- a ledger containing the chart of accounts and balances. If the
-- query includes a depth limit, that will affect the this ledger's
-- journal but not the ledger's account tree.
ledgerFromJournal :: Query -> Journal -> Ledger
ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
where
(q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
j' = filterJournalPostings q' j
j' =
dbg "ledgerFromJournal1" $
filterJournalPostingAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude
filterJournalPostings q' j
as = accountsFromPostings $ journalPostings j'
j'' = filterJournalPostings depthq j'

View File

@ -16,9 +16,11 @@ module Hledger.Query (
filterQuery,
-- * accessors
queryIsNull,
queryIsAcct,
queryIsDepth,
queryIsDate,
queryIsStartDateOnly,
queryIsSym,
queryStartDate,
queryDateSpan,
queryDepth,
@ -26,9 +28,10 @@ module Hledger.Query (
inAccount,
inAccountQuery,
-- * matching
matchesAccount,
matchesPosting,
matchesTransaction,
matchesPosting,
matchesAccount,
matchesAmount,
-- * tests
tests_Hledger_Query
)
@ -391,6 +394,10 @@ queryIsAcct :: Query -> Bool
queryIsAcct (Acct _) = True
queryIsAcct _ = False
queryIsSym :: Query -> Bool
queryIsSym (Sym _) = True
queryIsSym _ = False
-- | Does this query specify a start date and nothing else (that would
-- filter postings prior to the date) ?
-- When the flag is true, look for a starting secondary date instead.
@ -517,6 +524,25 @@ tests_matchesAccount = [
assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"
]
-- | Does the match expression match this (simple) amount ?
matchesAmount :: Query -> Amount -> Bool
matchesAmount (Not q) a = not $ q `matchesAmount` a
matchesAmount (Any) _ = True
matchesAmount (None) _ = False
matchesAmount (Or qs) a = any (`matchesAmount` a) qs
matchesAmount (And qs) a = all (`matchesAmount` a) qs
matchesAmount (Amt op n) a = compareMixedAmount op n (Mixed [a])
matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ acommodity a
matchesAmount _ _ = True
-- | Is this simple mixed amount's quantity less than, equal to, or greater than this number ?
-- For complext mixed amounts (with multiple commodities), this is always true.
compareMixedAmount :: Ordering -> Quantity -> MixedAmount -> Bool
compareMixedAmount op q (Mixed []) = compareMixedAmount op q (Mixed [amount])
-- compareMixedAmount op q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == op
compareMixedAmount op q (Mixed [a]) = compare (aquantity a) q == op
compareMixedAmount _ _ _ = True
-- | Does the match expression match this posting ?
matchesPosting :: Query -> Posting -> Bool
matchesPosting (Not q) p = not $ q `matchesPosting` p
@ -542,14 +568,6 @@ matchesPosting (Tag n Nothing) p = isJust $ lookupTagByName n $ postingAllTags p
matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p
-- matchesPosting _ _ = False
-- | Is this simple mixed amount's quantity less than, equal to, or greater than this number ?
-- For complext mixed amounts (with multiple commodities), this is always true.
compareMixedAmount :: Ordering -> Quantity -> MixedAmount -> Bool
compareMixedAmount op q (Mixed []) = compareMixedAmount op q (Mixed [amount])
-- compareMixedAmount op q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == op
compareMixedAmount op q (Mixed [a]) = compare (aquantity a) q == op
compareMixedAmount _ _ _ = True
tests_matchesPosting = [
"matchesPosting" ~: do
-- matching posting status..

View File

@ -315,11 +315,19 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
wd = whichDateFromOpts opts
-- delay depth filtering until the end
(depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)
(precedingps, displayableps, _) = dbg "ps4" $ postingsMatchingDisplayExpr displayexpr opts
$ dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id)
$ dbg "ps2" $ filter (q' `matchesPosting`)
$ dbg "ps1" $ journalPostings j'
-- enable to debug just this function
(precedingps, displayableps, _) =
dbg "ps5" $
postingsMatchingDisplayExpr displayexpr opts $ -- filter and group by the -d display expression
dbg "ps4" $
map (filterPostingAmount (filterQuery queryIsSym q)) $ -- remove amount parts which the query's sym: terms would exclude
dbg "ps3" $
(if related_ opts then concatMap relatedPostings else id) $ -- with --related, replace each with its sibling postings
dbg "ps2" $
filter (q' `matchesPosting`) $ -- filter postings by the query, ignoring depth
dbg "ps1" $
journalPostings j'
-- to debug just this function without the noise of --debug, uncomment:
-- dbg :: Show a => String -> a -> a
-- dbg = lstrace
@ -530,6 +538,10 @@ filterTransactionsReportByCommodity c (label,items) =
filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity c (Mixed as) = Mixed $ filter ((==c). acommodity) as
-- -- | Filter out all parts of this amount which do not match the query.
-- filterMixedAmount :: Query -> MixedAmount -> MixedAmount
-- filterMixedAmount q (Mixed as) = Mixed $ filter (q `matchesAmount`) as
-- | Select transactions from the whole journal. This is similar to a
-- "postingsReport" except with transaction-based report items which
-- are ordered most recent first. This is used by eg hledger-web's journal view.
@ -649,7 +661,10 @@ balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReport opts q j = (items, total)
where
l = ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
accts = clipAccounts (queryDepth q) $ ledgerRootAccount l
accts =
dbg "accts1" $
clipAccounts (queryDepth q) $ -- exclude accounts deeper than specified depth
ledgerRootAccount l
accts'
| flat_ opts = filterzeros $ tail $ flattenAccounts accts
| otherwise = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts
@ -664,6 +679,11 @@ balanceReport opts q j = (items, total)
total = sum [amt | (a,_,indent,amt) <- items, if flat_ opts then accountNameLevel a == 1 else indent == 0]
-- XXX check account level == 1 is valid when top-level accounts excluded
-- -- | Filter out parts of this accounts balance amounts which do not match the query.
-- filterAccountAmounts :: Query -> Account -> Account
-- filterAccountAmounts q acc@Account{..} =
-- acc{aebalance=filterMixedAmount q aebalance, aibalance=filterMixedAmount q aibalance}
-- | In an account tree with zero-balance leaves removed, mark the
-- elidable parent accounts (those with one subaccount and no balance
-- of their own).