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, journalConvertAmountsToCost,
journalFinalise, journalFinalise,
-- * Filtering -- * Filtering
filterJournalPostings,
filterJournalTransactions, filterJournalTransactions,
filterJournalPostings,
filterJournalPostingAmounts,
filterPostingAmount,
-- * Querying -- * Querying
journalAccountNames, journalAccountNames,
journalAccountNamesUsed, journalAccountNamesUsed,
@ -28,6 +30,7 @@ module Hledger.Data.Journal (
journalAmounts, journalAmounts,
-- journalCanonicalCommodities, -- journalCanonicalCommodities,
journalDateSpan, journalDateSpan,
journalDescriptions,
journalFilePath, journalFilePath,
journalFilePaths, journalFilePaths,
journalPostings, journalPostings,
@ -153,13 +156,19 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } 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 :: Journal -> [Posting]
journalPostings = concatMap tpostings . jtxns journalPostings = concatMap tpostings . jtxns
-- | All account names used in this journal. -- | Unique account names posted to in this journal.
journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings
-- | Unique account names in this journal, including parent accounts containing no postings.
journalAccountNames :: Journal -> [AccountName] journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
@ -228,6 +237,17 @@ filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionposti
where where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} 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. -- | Keep only transactions matching the query expression.
filterJournalTransactions :: Query -> Journal -> Journal filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts} 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.Journal
import Hledger.Data.Posting import Hledger.Data.Posting
import Hledger.Query import Hledger.Query
import Hledger.Utils
instance Show Ledger where instance Show Ledger where
@ -35,16 +36,19 @@ nullledger = Ledger {
laccounts = [] laccounts = []
} }
-- | Filter a journal's transactions with the given query, then derive a -- | Filter a journal's transactions with the given query, then derive
-- ledger containing the chart of accounts and balances. If the query -- a ledger containing the chart of accounts and balances. If the
-- includes a depth limit, that will affect the ledger's journal but not -- query includes a depth limit, that will affect the this ledger's
-- the account tree. -- journal but not the ledger's account tree.
ledgerFromJournal :: Query -> Journal -> Ledger ledgerFromJournal :: Query -> Journal -> Ledger
ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as} ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
where where
(q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q) (q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
j' = filterJournalPostings q' j j' =
as = accountsFromPostings $ journalPostings 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' j'' = filterJournalPostings depthq j'
-- | List a ledger's account names. -- | List a ledger's account names.

View File

@ -16,9 +16,11 @@ module Hledger.Query (
filterQuery, filterQuery,
-- * accessors -- * accessors
queryIsNull, queryIsNull,
queryIsAcct,
queryIsDepth, queryIsDepth,
queryIsDate, queryIsDate,
queryIsStartDateOnly, queryIsStartDateOnly,
queryIsSym,
queryStartDate, queryStartDate,
queryDateSpan, queryDateSpan,
queryDepth, queryDepth,
@ -26,9 +28,10 @@ module Hledger.Query (
inAccount, inAccount,
inAccountQuery, inAccountQuery,
-- * matching -- * matching
matchesAccount,
matchesPosting,
matchesTransaction, matchesTransaction,
matchesPosting,
matchesAccount,
matchesAmount,
-- * tests -- * tests
tests_Hledger_Query tests_Hledger_Query
) )
@ -391,6 +394,10 @@ queryIsAcct :: Query -> Bool
queryIsAcct (Acct _) = True queryIsAcct (Acct _) = True
queryIsAcct _ = False queryIsAcct _ = False
queryIsSym :: Query -> Bool
queryIsSym (Sym _) = True
queryIsSym _ = False
-- | Does this query specify a start date and nothing else (that would -- | Does this query specify a start date and nothing else (that would
-- filter postings prior to the date) ? -- filter postings prior to the date) ?
-- When the flag is true, look for a starting secondary date instead. -- 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" 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 ? -- | Does the match expression match this posting ?
matchesPosting :: Query -> Posting -> Bool matchesPosting :: Query -> Posting -> Bool
matchesPosting (Not q) p = not $ q `matchesPosting` p 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 (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p
-- matchesPosting _ _ = False -- 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 = [ tests_matchesPosting = [
"matchesPosting" ~: do "matchesPosting" ~: do
-- matching posting status.. -- matching posting status..

View File

@ -315,11 +315,19 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
wd = whichDateFromOpts opts wd = whichDateFromOpts opts
-- delay depth filtering until the end -- delay depth filtering until the end
(depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q) (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)
(precedingps, displayableps, _) = dbg "ps4" $ postingsMatchingDisplayExpr displayexpr opts (precedingps, displayableps, _) =
$ dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id) dbg "ps5" $
$ dbg "ps2" $ filter (q' `matchesPosting`) postingsMatchingDisplayExpr displayexpr opts $ -- filter and group by the -d display expression
$ dbg "ps1" $ journalPostings j' dbg "ps4" $
-- enable to debug just this function 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 :: Show a => String -> a -> a
-- dbg = lstrace -- dbg = lstrace
@ -530,6 +538,10 @@ filterTransactionsReportByCommodity c (label,items) =
filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity c (Mixed as) = Mixed $ filter ((==c). acommodity) as 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 -- | Select transactions from the whole journal. This is similar to a
-- "postingsReport" except with transaction-based report items which -- "postingsReport" except with transaction-based report items which
-- are ordered most recent first. This is used by eg hledger-web's journal view. -- 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) balanceReport opts q j = (items, total)
where where
l = ledgerFromJournal q $ journalSelectingAmountFromOpts opts j 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' accts'
| flat_ opts = filterzeros $ tail $ flattenAccounts accts | flat_ opts = filterzeros $ tail $ flattenAccounts accts
| otherwise = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros 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] 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 -- 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 -- | In an account tree with zero-balance leaves removed, mark the
-- elidable parent accounts (those with one subaccount and no balance -- elidable parent accounts (those with one subaccount and no balance
-- of their own). -- of their own).