fix: reg: register --related should not create duplicate postings when

more than one posting in a transaction matches. (#1629)
This commit is contained in:
Stephen Morgan 2021-07-28 17:46:29 +10:00 committed by Simon Michael
parent 6528f25593
commit 9df574b3c0
3 changed files with 44 additions and 14 deletions

View File

@ -31,9 +31,11 @@ module Hledger.Data.Journal (
-- * Filtering -- * Filtering
filterJournalTransactions, filterJournalTransactions,
filterJournalPostings, filterJournalPostings,
filterJournalRelatedPostings,
filterJournalAmounts, filterJournalAmounts,
filterTransactionAmounts, filterTransactionAmounts,
filterTransactionPostings, filterTransactionPostings,
filterTransactionRelatedPostings,
filterPostingAmount, filterPostingAmount,
-- * Mapping -- * Mapping
journalMapTransactions, journalMapTransactions,
@ -105,7 +107,7 @@ import Data.Foldable (toList)
import Data.Function ((&)) import Data.Function ((&))
import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.Class as H (toList)
import qualified Data.HashTable.ST.Cuckoo as H import qualified Data.HashTable.ST.Cuckoo as H
import Data.List (find, foldl', sortOn) import Data.List ((\\), find, foldl', sortOn)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe, maybeToList) import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe, maybeToList)
@ -517,6 +519,11 @@ filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTran
filterJournalPostings :: Query -> Journal -> Journal filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts} filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts}
-- | Keep only postings which do not match the query expression, but for which a related posting does.
-- This can leave unbalanced transactions.
filterJournalRelatedPostings :: Query -> Journal -> Journal
filterJournalRelatedPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionRelatedPostings q) ts}
-- | Within each posting's amount, keep only the parts matching the query. -- | Within each posting's amount, keep only the parts matching the query.
-- This can leave unbalanced transactions. -- This can leave unbalanced transactions.
filterJournalAmounts :: Query -> Journal -> Journal filterJournalAmounts :: Query -> Journal -> Journal
@ -534,6 +541,11 @@ filterPostingAmount q p@Posting{pamount=as} = p{pamount=filterMixedAmount (q `ma
filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}
filterTransactionRelatedPostings :: Query -> Transaction -> Transaction
filterTransactionRelatedPostings q t@Transaction{tpostings=ps} =
t{tpostings=if null matches then [] else ps \\ matches}
where matches = filter (matchesPosting q) ps
-- | Apply a transformation to a journal's transactions. -- | Apply a transformation to a journal's transactions.
journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts} journalMapTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts}

View File

@ -119,20 +119,21 @@ matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q}
where where
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan
beforeandduringps = beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 dbg5 "ps4" $ sortOn sortdate $ -- sort postings by date or date2
dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts dbg5 "ps3" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts
dbg5 "ps3" $ (if related_ ropts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
journalPostings $ journalPostings $
journalApplyValuationFromOpts rspec $ -- convert to cost and apply valuation journalApplyValuationFromOpts rspec $ -- convert to cost and apply valuation
dbg5 "ps2" $ filterJournalAmounts symq $ -- remove amount parts which the query's cur: terms would exclude dbg5 "ps2" $ filterJournalAmounts symq $ -- remove amount parts which the query's cur: terms would exclude
dbg5 "ps1" $ filterJournalPostings beforeandduringq j -- filter postings by the query, with no start date or depth limit dbg5 "ps1" $ filterJournal beforeandduringq j -- filter postings by the query, with no start date or depth limit
where
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
where where
depthless = filterQuery (not . queryIsDepth) depthless = filterQuery (not . queryIsDepth)
dateless = filterQuery (not . queryIsDateOrDate2) dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan
sortdate = if date2_ ropts then postingDate2 else postingDate sortdate = if date2_ ropts then postingDate2 else postingDate
filterJournal = if related_ ropts then filterJournalRelatedPostings else filterJournalPostings -- with -r, replace each posting with its sibling postings
symq = dbg4 "symq" $ filterQuery queryIsSym q symq = dbg4 "symq" $ filterQuery queryIsSym q
dateqtype dateqtype
| queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2 | queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2

View File

@ -0,0 +1,17 @@
# 1. related postings will only display each posting once
<
P 2021-01-01 A 10 B
2021-01-01
(a) 1 A
(a) 2 A
(b) 3 A
$ hledger -f- register a --related
2021-01-01 (b) 3 A 3 A
>=
# 2. related postings will display valued postings when requested
$ hledger -f- register a --related -V
2021-01-01 (b) 30 B 30 B
>=