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

more than one posting in a transaction matches. (#1629)

hledger-lib/Hledger/Data/Journal.hs

@@ -31,9 +31,11 @@ module Hledger.Data.Journal (
   -- * Filtering
   filterJournalTransactions,
   filterJournalPostings,
+  filterJournalRelatedPostings,
   filterJournalAmounts,
   filterTransactionAmounts,
   filterTransactionPostings,
+  filterTransactionRelatedPostings,
   filterPostingAmount,
   -- * Mapping
   journalMapTransactions,
@@ -105,7 +107,7 @@ import Data.Foldable (toList)
 import Data.Function ((&))
 import qualified Data.HashTable.Class as H (toList)
 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 qualified Data.Map.Strict as M
 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 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.
 -- This can leave unbalanced transactions.
 filterJournalAmounts :: Query -> Journal -> Journal
@@ -534,6 +541,11 @@ filterPostingAmount q p@Posting{pamount=as} = p{pamount=filterMixedAmount (q `ma
 filterTransactionPostings :: Query -> Transaction -> Transaction
 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.
 journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
 journalMapTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts}

hledger-lib/Hledger/Reports/PostingsReport.hs

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

hledger/test/register/related.test

@@ -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
+>=