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