lib: Generate conversion postings for priced amounts.

This means there will no longer be unbalanced transactions, but will be offsetting conversion postings to balance things out. For example. 2000-01-01 a 1 AAA @@ 2 BBB b -2 BBB When converting to cost, this is treated the same as before. When not converting to cost, this is now treated as: 2000-01-01 a 1 AAA b -2 BBB equity:conversion:AAA:BBB -1 AAA equity:conversion:BBB:AAA 2 BBB
simonmichael · May 5, 2021 · dcf3189 · dcf3189
1 parent 0078f1a
commit dcf3189
Show file tree

Hide file tree

Showing 7 changed files with 64 additions and 29 deletions.
diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs
@@ -129,6 +129,7 @@ import Hledger.Data.Amount
 import Hledger.Data.Dates
 import Hledger.Data.Transaction
 import Hledger.Data.TransactionModifier
+import Hledger.Data.Valuation
 import Hledger.Data.Posting
 import Hledger.Query
 import Data.List (sortBy)
@@ -1193,8 +1194,8 @@ postingInferredmarketPrice p@Posting{pamount} =
 
 -- | Convert all this journal's amounts to cost using the transaction prices, if any.
 -- The journal's commodity styles are applied to the resulting amounts.
-journalToCost :: Journal -> Journal
-journalToCost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles) ts}
+journalToCost :: Costing -> Journal -> Journal
+journalToCost cost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost cost styles) ts}
     where
       styles = journalCommodityStyles j
 

diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs
@@ -336,9 +336,13 @@ aliasReplace (RegexAlias re repl) a =
 -- using the provided price oracle, commodity styles, and reference dates.
 -- Costing is done first if requested, and after that any valuation.
 -- See amountApplyValuation and amountCost.
-postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting
-postingApplyCostValuation priceoracle styles periodlast today cost v p =
-    postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p
+postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> [Posting]
+postingApplyCostValuation priceoracle styles periodlast today cost value p =
+    valuation $ postingToCost cost styles p
+  where
+    valuation = case value of
+      Nothing -> id
+      Just v  -> map (postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v))
 
 -- | Apply a specified valuation to this posting's amount, using the
 -- provided price oracle, commodity styles, and reference dates.
@@ -347,9 +351,32 @@ postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day
 postingApplyValuation priceoracle styles periodlast today v p =
     postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p
 
--- | Convert this posting's amount to cost, and apply the appropriate amount styles.
-postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
-postingToCost styles = postingTransformAmount (styleMixedAmount styles . mixedAmountCost)
+-- | Convert this posting's amount to cost, and apply the appropriate amount styles,
+-- if requested. Otherwise, generate a list of postings including the conversions for
+-- any prices involved. The new postings will have two tags added: a normal generated-posting:
+-- tag which also appears in the comment, and a hidden _generated-posting: tag which does not.
+postingToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Posting -> [Posting]
+postingToCost Cost   styles p = [postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p]
+postingToCost NoCost styles p = p : concatMap conversionPostings (amountsRaw $ pamount p)
+  where
+    conversionPostings amt = case aprice amt of
+        Nothing -> []
+        Just _  -> [ cp{ paccount = "equity:conversion:" <> amtCommodity <> ":" <> costCommodity
+                       , pamount  = mixedAmount . negate $ amountStripPrices amt }
+                   , cp{ paccount = "equity:conversion:" <> costCommodity <> ":" <> amtCommodity
+                       , pamount  = styleMixedAmount styles $ mixedAmount cost }
+                   ]
+      where
+        cost = amountCost amt
+        amtCommodity  = commodity amt
+        costCommodity = commodity cost
+        cp = p{ pcomment = pcomment p `commentAddTag` ("generated-posting","")
+              , ptags = [("generated-posting", ""), ("_generated-posting", "")]
+              , pbalanceassertion = Nothing
+              , poriginal = Nothing
+              }
+        -- Take the commodity of an amount and collapse consecutive spaces to a single space
+        commodity = T.unwords . filter (not . T.null) . T.words . acommodity
 
 -- | Apply a transform function to this posting's amount.
 postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting

diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs
@@ -619,8 +619,8 @@ transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f p
 -- using the provided price oracle, commodity styles, and reference dates.
 -- See amountApplyValuation and amountCost.
 transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction
-transactionApplyCostValuation priceoracle styles periodlast today cost v =
-  transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v)
+transactionApplyCostValuation priceoracle styles periodlast today cost v t@Transaction{tpostings=ps} =
+  t{tpostings=concatMap (postingApplyCostValuation priceoracle styles periodlast today cost v) ps}
 
 -- | Apply a specified valuation to this transaction's amounts, using
 -- the provided price oracle, commodity styles, and reference dates.
@@ -630,8 +630,8 @@ transactionApplyValuation priceoracle styles periodlast today v =
   transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v)
 
 -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles.
-transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction
-transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps}
+transactionToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction
+transactionToCost cost styles t@Transaction{tpostings=ps} = t{tpostings=concatMap (postingToCost cost styles) ps}
 
 -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases.
 -- This can fail due to a bad replacement pattern in a regular expression alias.

diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs
@@ -40,8 +40,15 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
     -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
     tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
       where
-        pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_
-          where periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
+        pvalue = valuation . costing
+          where
+            valuation   = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_
+            costing     = case cost_ of
+                Cost   -> postingTransformAmount mixedAmountCost
+                NoCost -> id
+            priceoracle = journalPriceOracle infer_value_ j
+            styles      = journalCommodityStyles j
+            periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
 
 tests_EntriesReport = tests "EntriesReport" [
   tests "entriesReport" [

diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs
@@ -248,8 +248,9 @@ getPostings :: ReportSpec -> Journal -> [(Posting, Day)]
 getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
     map (\p -> (p, date p)) .
     journalPostings .
-    filterJournalAmounts symq .    -- remove amount parts excluded by cur:
-    filterJournalPostings reportq  -- remove postings not matched by (adjusted) query
+    filterJournalAmounts symq .      -- remove amount parts excluded by cur:
+    filterJournalPostings reportq .  -- remove postings not matched by (adjusted) query
+    journalSelectingAmountFromOpts ropts
   where
     symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query
     -- The user's query with no depth limit, and expanded to the report span
@@ -565,13 +566,12 @@ postingAndAccountValuations ReportSpec{rsToday=today, rsOpts=ropts} j priceoracl
     -- Otherwise, all costing and valuation should be done on the Postings.
     _                -> (pvalue (value_ ropts), const id)
   where
-    -- For a Posting: convert to cost, apply valuation, then strip prices if we don't need them (See issue #1507).
-    pvalue v span = maybeStripPrices . postingApplyCostValuation priceoracle styles (end span) today (cost_ ropts) v
+    -- For a Posting: Apply valuation, then strip prices if we don't need them (See issue #1507).
+    pvalue v span = maybe id (postingApplyValuation priceoracle styles (end span) today) v
     -- For an Account: Apply valuation to both the inclusive and exclusive balances.
     avalue v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
       where value = mixedAmountApplyValuation priceoracle styles (end span) today (error "multiBalanceReport: did not expect amount valuation to be called ") v  -- PARTIAL: should not happen
 
-    maybeStripPrices = if show_costs_ ropts then id else postingStripPrices
     end = maybe (error "multiBalanceReport: expected all spans to have an end date")  -- PARTIAL: should not happen
             (addDays (-1)) . spanEnd
     styles = journalCommodityStyles j

diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs
@@ -76,14 +76,14 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
       (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
 
       -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
-      -- Strip prices from postings if we won't need them.
-      pvalue periodlast = maybeStripPrices . postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_
-        where maybeStripPrices = if show_costs_ then id else postingStripPrices
+      pvalue periodlast = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_
 
       -- Postings, or summary postings with their subperiod's end date, to be displayed.
       displayps :: [(Posting, Maybe Day)]
-        | multiperiod, Just (AtEnd _) <- value_ = [(pvalue lastday p, Just periodend) | (p, periodend) <- summariseps reportps, let lastday = addDays (-1) periodend]
-        | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps valuedps]
+        | multiperiod, Just (AtEnd _) <- value_ = [ (pvalue lastday p, Just pend)
+                                                  | (p, pend) <- summariseps reportps
+                                                  , let lastday = addDays (-1) pend ]
+        | multiperiod = [(p, Just pend) | (p, pend) <- summariseps valuedps]
         | otherwise   = [(p, Nothing) | p <- valuedps]
         where
           summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan
@@ -141,7 +141,7 @@ matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan ms
       dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $  -- with -r, replace each with its sibling postings
       dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $                  -- filter postings by the query, with no start date or depth limit
                   journalPostings $
-                  journalSelectingAmountFromOpts ropts j    -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?
+                  journalSelectingAmountFromOpts ropts j                         -- maybe convert to cost early, will be seen by amt:.
       where
         beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
           where

diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs
@@ -490,11 +490,11 @@ flat_ = not . tree_
 
 -- | Convert this journal's postings' amounts to cost using their
 -- transaction prices, if specified by options (-B/--cost).
--- Maybe soon superseded by newer valuation code.
+-- Also strip prices if they will not be used.
 journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
-journalSelectingAmountFromOpts opts = case cost_ opts of
-    Cost   -> journalToCost
-    NoCost -> id
+journalSelectingAmountFromOpts ropts =
+  (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices)
+  . journalToCost (cost_ ropts)
 
 -- | Convert report options to a query, ignoring any non-flag command line arguments.
 queryFromFlags :: ReportOpts -> Query