lib: Infer prices correctly even when there are only balance assignments.

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
+    postings     = filter ((==pt).ptype) $ tpostings t
-    pmixedamounts  = map pamount postings
+    pcommodities = map acommodity $ concatMap (amounts . pamount) postings
-    pcommodities   = map acommodity $ concatMap amountsRaw pmixedamounts
+    sumamounts   = amounts $ sumPostings postings  -- amounts normalises to one amount per commodity & price
-    sumamounts     = amounts $ maSum pmixedamounts  -- sum normalises to one amount per commodity & price
+    noprices     = all (isNothing . aprice) sumamounts
-    sumcommodities = map acommodity sumamounts
-    sumprices      = filter isJust $ map aprice sumamounts
-    caninferprices = length sumcommodities == 2 && null sumprices
 
-    inferprice p@Posting{pamount=amt} = case amountsRaw amt of
+    -- We can infer prices if there are no prices given, and exactly two commodities in the
-      [a] | caninferprices && ptype p == pt && acommodity a == fromcommodity
+    -- normalised sum of postings in this transaction. The amount we are converting from is
-            -> p{ pamount=mixedAmount a{aprice=Just conversionprice}
+    -- the first commodity to appear in the ordered list of postings, and the commodity we
-                , poriginal=Just $ originalPosting p}
+    -- are converting to is the other. If we cannot infer prices, return Nothing.
-        where
+    inferFromAndTo [a,b] | noprices = asum $ map orderIfMatches pcommodities
-          fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
+      where orderIfMatches x | x == acommodity a = Just (a,b)
-          totalpricesign = if aquantity a < 0 then negate else id
+                             | x == acommodity b = Just (b,a)
-          conversionprice = case filter (==fromcommodity) pcommodities of
+                             | otherwise         = Nothing
-              [_] -> TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision
+    inferFromAndTo _ = Nothing
-              _   -> UnitPrice $ abs unitprice `withPrecision` unitprecision
+
-            where
+    -- For each posting, if the posting type matches, there is only a single amount in the posting,
-              fromamount    = head $ filter ((==fromcommodity).acommodity) sumamounts
+    -- and the commodity of the amount matches the amount we're converting from,
-              fromprecision = asprecision $ astyle fromamount
+    -- then set its price based on the ratio between fromamount and toamount.
-              tocommodity   = head $ filter (/=fromcommodity) sumcommodities
+    inferprice (fromamount, toamount) posting
-              toamount      = head $ filter ((==tocommodity).acommodity) sumamounts
+        | [a] <- amounts (pamount posting), ptype posting == pt, acommodity a == acommodity fromamount
-              toprecision   = asprecision $ astyle toamount
+        , let totalpricesign = if aquantity a < 0 then negate else id
-              unitprice     = aquantity fromamount `divideAmount` toamount
+            = posting{ pamount   = mixedAmount a{aprice=Just $ conversionprice totalpricesign}
-              -- Sum two display precisions, capping the result at the maximum bound
+                     , poriginal = Just $ originalPosting posting }
-              unitprecision = case (fromprecision, toprecision) of
+        | otherwise = posting
-                  (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b)
+      where
-                  _                          -> NaturalPrecision
+        -- If only one Amount in the posting list matches fromamount we can use TotalPrice,
-      _ -> p
+        -- 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

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