diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 28173738c..5de846222 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -60,6 +60,7 @@ module Hledger.Data.Amount ( divideAmount, multiplyAmount, amountValue, + amountTotalPriceToUnitPrice, -- ** rendering amountstyle, styleAmount, @@ -99,6 +100,7 @@ module Hledger.Data.Amount ( isReallyZeroMixedAmount, isReallyZeroMixedAmountCost, mixedAmountValue, + mixedAmountTotalPriceToUnitPrice, -- ** rendering styleMixedAmount, showMixedAmount, @@ -209,6 +211,17 @@ costOfAmount a@Amount{aquantity=q, aprice=price} = UnitPrice p@Amount{aquantity=pq} -> p{aquantity=pq * q} TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q} +-- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice. +-- Has no effect on amounts without one. +-- Also increases the unit price's display precision to show one extra decimal place, +-- to help the unit-priced amounts to still balance. +-- Does Decimal division, might be some rounding/irrational number issues. +amountTotalPriceToUnitPrice :: Amount -> Amount +amountTotalPriceToUnitPrice + a@Amount{aquantity=q, aprice=TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}}} + = a{aprice = UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}} +amountTotalPriceToUnitPrice a = a + -- | Divide an amount's quantity by a constant. divideAmount :: Amount -> Quantity -> Amount divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d} @@ -665,6 +678,12 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as +-- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. +-- Has no effect on amounts without one. +-- Does Decimal division, might be some rounding/irrational number issues. +mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount +mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnitPrice as + ------------------------------------------------------------------------------- -- tests diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 33d85fbe7..d4ab4a7c1 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -24,7 +24,7 @@ import Hledger.Data.Amount import Hledger.Data.Transaction import Hledger.Query import Hledger.Utils.UTF8IOCompat (error') --- import Hledger.Utils.Debug +import Hledger.Utils.Debug -- $setup -- >>> :set -XOverloadedStrings @@ -78,6 +78,8 @@ tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting"). +-- The new posting's amount can optionally be the old posting's amount multiplied by a constant. +-- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced. tmPostingRuleToFunction :: TMPostingRule -> (Posting -> Posting) tmPostingRuleToFunction pr = \p -> renderPostingCommentDates $ pr @@ -88,10 +90,21 @@ tmPostingRuleToFunction pr = where amount' = case postingRuleMultiplier pr of Nothing -> const $ pamount pr - Just n -> \p -> withAmountType (head $ amounts $ pamount pr) $ pamount p `multiplyMixedAmount` n - withAmountType pramount (Mixed as) = case acommodity pramount of - "" -> Mixed as - c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] + Just n -> \p -> + -- Multiply the old posting's amount by the posting rule's multiplier. + -- Its display precision will be increased if needed to show all digits. + let + pramount = dbg6 "pramount" $ head $ amounts $ pamount pr + matchedamount = dbg6 "matchedamount" $ pamount p + unitpricedmatchedamount = dbg6 "unitpricedmatchedamount" $ mixedAmountTotalPriceToUnitPrice matchedamount + Mixed as = dbg6 "scaledmatchedamount" $ unitpricedmatchedamount `multiplyMixedAmount` n + in + case acommodity pramount of + "" -> Mixed as + -- TODO multipliers with commodity symbols are not yet a documented feature. + -- For now: in addition to multiplying the quantity, it also replaces the + -- matched amount's commodity, display style, and price with those of the posting rule. + c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] postingRuleMultiplier :: TMPostingRule -> Maybe Quantity postingRuleMultiplier p = diff --git a/tests/journal/modifiers-928.test b/tests/journal/modifiers-928.test new file mode 100644 index 000000000..d58e0d7af --- /dev/null +++ b/tests/journal/modifiers-928.test @@ -0,0 +1,64 @@ +# Issue #928 + +# Generating auto postings from a unit-priced amount. +< += ^Expenses:Joint + Expenses:Joint *-1 + Liabilities:Joint:Bob *0.5 + Liabilities:Joint:Bill *0.5 + +2018/01/01 + Expenses:Joint:Widgets $100.00 @ £0.50 + Assets:Joint:Bank -£50.00 + +$ hledger -f- print --auto +2018/01/01 + Expenses:Joint:Widgets $100.00 @ £0.50 + Expenses:Joint $-100.00 @ £0.50 + Liabilities:Joint:Bob $50.00 @ £0.50 + Liabilities:Joint:Bill $50.00 @ £0.50 + Assets:Joint:Bank £-50.00 + +>=0 + +# Generating auto postings from a total-priced amount. +< += ^Expenses:Joint + Expenses:Joint *-1 + Liabilities:Joint:Bob *0.5 + Liabilities:Joint:Bill *0.5 + +2018/01/01 + Expenses:Joint:Widgets $100.00 @@ £50 + Assets:Joint:Bank -£50.00 + +$ hledger -f- print --auto +2018/01/01 + Expenses:Joint:Widgets $100.00 @@ £50 + Expenses:Joint $-100.00 @ £0.5 + Liabilities:Joint:Bob $50.00 @ £0.5 + Liabilities:Joint:Bill $50.00 @ £0.5 + Assets:Joint:Bank £-50.00 + +>=0 + +# Generating auto postings from an implicitly-priced amount. Same as above. +< += ^Expenses:Joint + Expenses:Joint *-1 + Liabilities:Joint:Bob *0.5 + Liabilities:Joint:Bill *0.5 + +2018/01/01 + Expenses:Joint:Widgets $100.00 + Assets:Joint:Bank -£50.00 + +$ hledger -f- print --auto +2018/01/01 + Expenses:Joint:Widgets $100.00 + Expenses:Joint $-100.00 @ £0.5 + Liabilities:Joint:Bob $50.00 @ £0.5 + Liabilities:Joint:Bill $50.00 @ £0.5 + Assets:Joint:Bank £-50.00 + +>=0