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, |   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} | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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.. | ||||||
|  | |||||||
| @ -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). | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user