balance, register now filter more strongly by sym:
This commit is contained in:
parent
73c09f91d7
commit
46d594bada
@ -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}
|
||||
|
||||
@ -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,16 +36,19 @@ 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
|
||||
as = accountsFromPostings $ journalPostings 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'
|
||||
|
||||
-- | List a ledger's account names.
|
||||
|
||||
@ -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..
|
||||
|
||||
@ -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).
|
||||
|
||||
Loading…
Reference in New Issue
Block a user