From 0078f1a5208e771dd517fc2f378d3713680d9e90 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 13 Apr 2021 17:41:58 +1000 Subject: [PATCH] lib: Infer prices correctly even when there are only balance assignments. --- hledger-lib/Hledger/Data/Transaction.hs | 73 +++++++++++--------- hledger/test/journal/balance-assertions.test | 7 ++ 2 files changed, 48 insertions(+), 32 deletions(-) diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 1f71004f6..54e9d93c5 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -63,9 +63,10 @@ module Hledger.Data.Transaction ( where import Data.Default (def) +import Data.Foldable (asum) import Data.List (intercalate, partition) import Data.List.Extra (nubSort) -import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Maybe (fromMaybe, isNothing, mapMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif @@ -548,40 +549,48 @@ inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'} -- | Generate a posting update function which assigns a suitable balancing -- price to the posting, if and as appropriate for the given transaction and --- posting type (real or balanced virtual). +-- posting type (real or balanced virtual). If we cannot or should not infer +-- prices, just act as the identity on postings. priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting) -priceInferrerFor t pt = inferprice +priceInferrerFor t pt = maybe id inferprice $ inferFromAndTo sumamounts where - postings = filter ((==pt).ptype) $ tpostings t - pmixedamounts = map pamount postings - pcommodities = map acommodity $ concatMap amountsRaw pmixedamounts - sumamounts = amounts $ maSum pmixedamounts -- sum normalises to one amount per commodity & price - sumcommodities = map acommodity sumamounts - sumprices = filter isJust $ map aprice sumamounts - caninferprices = length sumcommodities == 2 && null sumprices + postings = filter ((==pt).ptype) $ tpostings t + pcommodities = map acommodity $ concatMap (amounts . pamount) postings + sumamounts = amounts $ sumPostings postings -- amounts normalises to one amount per commodity & price + noprices = all (isNothing . aprice) sumamounts - inferprice p@Posting{pamount=amt} = case amountsRaw amt of - [a] | caninferprices && ptype p == pt && acommodity a == fromcommodity - -> p{ pamount=mixedAmount a{aprice=Just conversionprice} - , poriginal=Just $ originalPosting p} - where - fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe - totalpricesign = if aquantity a < 0 then negate else id - conversionprice = case filter (==fromcommodity) pcommodities of - [_] -> TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision - _ -> UnitPrice $ abs unitprice `withPrecision` unitprecision - where - fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts - fromprecision = asprecision $ astyle fromamount - tocommodity = head $ filter (/=fromcommodity) sumcommodities - toamount = head $ filter ((==tocommodity).acommodity) sumamounts - toprecision = asprecision $ astyle toamount - unitprice = aquantity fromamount `divideAmount` toamount - -- Sum two display precisions, capping the result at the maximum bound - unitprecision = case (fromprecision, toprecision) of - (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b) - _ -> NaturalPrecision - _ -> p + -- We can infer prices if there are no prices given, and exactly two commodities in the + -- normalised sum of postings in this transaction. The amount we are converting from is + -- the first commodity to appear in the ordered list of postings, and the commodity we + -- are converting to is the other. If we cannot infer prices, return Nothing. + inferFromAndTo [a,b] | noprices = asum $ map orderIfMatches pcommodities + where orderIfMatches x | x == acommodity a = Just (a,b) + | x == acommodity b = Just (b,a) + | otherwise = Nothing + inferFromAndTo _ = Nothing + + -- For each posting, if the posting type matches, there is only a single amount in the posting, + -- and the commodity of the amount matches the amount we're converting from, + -- then set its price based on the ratio between fromamount and toamount. + inferprice (fromamount, toamount) posting + | [a] <- amounts (pamount posting), ptype posting == pt, acommodity a == acommodity fromamount + , let totalpricesign = if aquantity a < 0 then negate else id + = posting{ pamount = mixedAmount a{aprice=Just $ conversionprice totalpricesign} + , poriginal = Just $ originalPosting posting } + | otherwise = posting + where + -- If only one Amount in the posting list matches fromamount we can use TotalPrice, + -- but we need to know the sign. Otherwise divide the conversion equally among the + -- Amounts by using a unit price. + conversionprice sign = case filter (== acommodity fromamount) pcommodities of + [_] -> TotalPrice $ sign (abs toamount) `withPrecision` NaturalPrecision + _ -> UnitPrice $ abs unitprice `withPrecision` unitprecision + + unitprice = (aquantity fromamount) `divideAmount` toamount + unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of + (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b + _ -> NaturalPrecision + saturatedAdd a b = if maxBound - a < b then maxBound else a + b -- Get a transaction's secondary date, defaulting to the primary date. transactionDate2 :: Transaction -> Day diff --git a/hledger/test/journal/balance-assertions.test b/hledger/test/journal/balance-assertions.test index f5a357994..824ffbe41 100755 --- a/hledger/test/journal/balance-assertions.test +++ b/hledger/test/journal/balance-assertions.test @@ -190,6 +190,13 @@ $ hledger -f - stats a $0 = $7 b $0 = $-7 +2013/1/5 + (c) 100 A + +2013/1/5 + c = 50 B + c = 50 A + $ hledger -f - stats > /Transactions/ >=0