finish refactoring balanceTransaction

hledger-lib/Hledger/Data/Amount.hs

@@ -184,7 +184,7 @@ amountWithCommodity c a = a{acommodity=c, aprice=NoPrice}
 
 -- | Convert an amount to the commodity of its assigned price, if any.  Notes:
 --
--- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error)
+-- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error) XXX
 --
 -- - price amounts should be positive, though this is not currently enforced
 costOfAmount :: Amount -> Amount

hledger-lib/Hledger/Data/Transaction.hs

@@ -260,25 +260,13 @@ isTransactionBalanced styles t =
       bvsum' = canonicalise $ costOfMixedAmount bvsum
       canonicalise = maybe id canonicaliseMixedAmount styles
 
--- XXX refactor
 -- | Ensure this transaction is balanced, possibly inferring a missing
--- amount or conversion price, or return an error message.
+-- amount or conversion price(s), or return an error message.
---
+-- Balancing is affected by commodity display precisions, so those can
--- Balancing is affected by commodity display precisions, so those may
+-- (optionally) be provided.
--- be provided.
---
--- We can infer a missing real amount when there are multiple real
--- postings and exactly one of them is amountless (likewise for
--- balanced virtual postings). Inferred amounts are converted to cost
--- basis when possible.
---
--- We can infer a conversion price when all real amounts are specified
--- and the sum of real postings' amounts is exactly two
--- non-explicitly-priced amounts in different commodities (likewise
--- for balanced virtual postings).
 balanceTransaction :: Maybe (Map.Map Commodity AmountStyle) -> Transaction -> Either String Transaction
-balanceTransaction styles t@Transaction{tpostings=ps} =
+balanceTransaction styles t =
-  case inferAmounts t of
+  case inferBalancingAmount t of
     Left err           -> Left err
     Right tWithAmounts ->
      case isTransactionBalanced styles tWithAmountsAndPrices of
@@ -286,86 +274,28 @@ balanceTransaction styles t@Transaction{tpostings=ps} =
       True  -> Right $ txnTieKnot tWithAmountsAndPrices
 
      where
+      tWithAmountsAndPrices = (if tWithAmounts==t then inferBalancingPrices else id) tWithAmounts -- XXX unneeded ?
       printerr s = intercalate "\n" [s, showTransactionUnelided t]
-
+      nonzerobalanceerror :: Transaction -> String
-      -------------------------------------------------------------------------
+      nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg
-      -- infer conversion prices for real postings if needed
-      rmixedamountsinorder = map pamount $ realPostings tWithAmounts
-      ramountsinorder = concatMap amounts rmixedamountsinorder
-      rcommoditiesinorder  = map acommodity ramountsinorder
-      rsumamounts  = amounts $ sum rmixedamountsinorder
-      -- as it says above, we can infer a conversion price when
-      tWithAmountsAndRealPrices =
-            if tWithAmounts == t                       --  all real amounts were explicit (we didn't have to infer any)
-               && length rsumamounts == 2              -- and the sum of real amounts has exactly two commodities (assumption: summing mixed amounts normalises to one simple amount per commodity)
-               && all ((==NoPrice).aprice) rsumamounts -- and none of the amounts had explicit prices
-             then tWithAmounts{tpostings=map inferprice ps}
-             else tWithAmounts
           where
-            inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=NoPrice}], ptype=RegularPosting} -- assumption: a posting's mixed amount contains one simple amount
+            (rsum, _, bvsum) = transactionPostingBalances t
-                = p{pamount=Mixed [a{aprice=conversionprice c}]}
+            rmsg | isReallyZeroMixedAmountCost rsum = ""
-                where
+                 | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum)
-                  conversionprice c | c == unpricedcommodity
+            bvmsg | isReallyZeroMixedAmountCost bvsum = ""
+                  | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum)
+            sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String
 
-                                        -- calculate a price that makes the postings balance, and give it "just enough"
+-- | Infer up to one missing amount for this transactions's real postings, and
-                                        -- display precision that a manual calculation with the displayed numbers
+-- likewise for its balanced virtual postings, if needed; or return an error
-                                        -- shows the transaction balancing.
-                                        = if length ramountsinunpricedcommodity == 1
-
-                                           -- when there is only one posting in the target commodity,
-                                           -- show a total price (@@) for more exact output. In this
-                                           -- case show all available decimal digits, it shouldn't be too many.
-                                           then TotalPrice $ abs targetcommodityamount `withPrecision` maxprecision
-
-                                           -- otherwise, calculate the average unit conversion price across all postings.
-                                           -- Set the precision to the sum of the precisions of the commodities involved,
-                                           -- which should be enough to make calculation look right while also preventing
-                                           -- irrational numbers from printing excessive digits.
-                                           else UnitPrice $ abs unitprice `withPrecision` sumofprecisions
-
-                                    | otherwise = NoPrice
-                      where
-                        unpricedcommodity     = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder
-                        unpricedamount        = head $ filter ((==unpricedcommodity).acommodity) rsumamounts
-                        targetcommodityamount = head $ filter ((/=unpricedcommodity).acommodity) rsumamounts
-                        ramountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) ramountsinorder
-                        unitprice             = targetcommodityamount `divideAmount` (aquantity unpricedamount)
-                        sumofprecisions       = (asprecision $ astyle $ targetcommodityamount) + (asprecision $ astyle $ unpricedamount)
-            inferprice p = p
-
-      -------------------------------------------------------------------------
-      -- infer conversion prices for balanced virtual postings if needed. XXX duplicates the above
-      bvmixedamountsinorder = map pamount $ balancedVirtualPostings tWithAmountsAndRealPrices
-      bvamountsinorder = concatMap amounts bvmixedamountsinorder
-      bvcommoditiesinorder  = map acommodity bvamountsinorder
-      bvsumamounts  = amounts $ sum bvmixedamountsinorder
-      tWithAmountsAndPrices =
-           if length bvsumamounts == 2 && all ((==NoPrice).aprice) bvsumamounts && tWithAmounts==t -- XXX could check specifically for bv amount inferring
-             then tWithAmountsAndRealPrices{tpostings=map inferprice ps}
-             else tWithAmountsAndRealPrices
-          where
-            inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=NoPrice}], ptype=BalancedVirtualPosting}
-                = p{pamount=Mixed [a{aprice=conversionprice c}]}
-                where
-                  conversionprice c | c == unpricedcommodity
-                                        = if length bvamountsinunpricedcommodity == 1
-                                           then TotalPrice $ abs targetcommodityamount `withPrecision` maxprecision
-                                           else UnitPrice  $ abs unitprice             `withPrecision` sumofprecisions
-                                    | otherwise = NoPrice
-                      where
-                        unpricedcommodity     = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder
-                        unpricedamount        = head $ filter ((==unpricedcommodity).acommodity) bvsumamounts
-                        targetcommodityamount = head $ filter ((/=unpricedcommodity).acommodity) bvsumamounts
-                        bvamountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) bvamountsinorder
-                        unitprice             = targetcommodityamount `divideAmount` (aquantity unpricedamount)
-                        sumofprecisions       = (asprecision $ astyle $ targetcommodityamount) + (asprecision $ astyle $ unpricedamount)
-            inferprice p = p
-
--- | Infer up to one missing amount each for this transactions's real
--- and balanced virtual postings, if needed, or return an error
 -- message if we can't.
-inferAmounts :: Transaction -> Either String Transaction
+--
-inferAmounts t@Transaction{tpostings=ps}
+-- We can infer a missing amount when there are multiple postings and exactly
+-- one of them is amountless. If the amounts had price(s) the inferred amount
+-- have the same price(s), and will be converted to the price commodity.
+-- 
+inferBalancingAmount :: Transaction -> Either String Transaction
+inferBalancingAmount t@Transaction{tpostings=ps}
   | length amountlessrealps > 1
       = Left $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"
   | length amountlessbvps > 1
@@ -380,15 +310,78 @@ inferAmounts t@Transaction{tpostings=ps}
     inferamount p@Posting{ptype=BalancedVirtualPosting} | not (hasAmount p) = p{pamount=costOfMixedAmount (-bvsum)}
     inferamount p = p
 
-nonzerobalanceerror :: Transaction -> String
+-- | Infer prices for this transaction's posting amounts, if needed to make
-nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg
+-- the postings balance. This is done once for the real postings and again
-    where
+-- (separately) for the balanced virtual postings. When it's not possible, the
-      (rsum, _, bvsum) = transactionPostingBalances t
+-- transaction is left unchanged.
-      rmsg | isReallyZeroMixedAmountCost rsum = ""
+-- 
-           | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum)
+-- The simplest example is a transaction with two postings, each in a
-      bvmsg | isReallyZeroMixedAmountCost bvsum = ""
+-- different commodity, with no prices specified. In this case we'll add a
-            | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum)
+-- price to the first posting such that it can be converted to the commodity
-      sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String
+-- of the second posting (with -B), and such that the postings balance.
+-- 
+-- In general, we can infer a conversion price when the sum of posting amounts
+-- contains exactly two different commodities and no explicit prices.  The
+-- transaction could contain additional commodities, and/or prices, if they
+-- cancel out; what matters is that the sum of posting amounts contains
+-- exactly two commodities and zero prices.
+-- 
+-- There can also be more than two postings in either of the commodities.
+-- 
+-- We want to avoid excessive display of digits when the calculated price is
+-- an irrational number, while also ensuring the displayed numbers balance if
+-- the user does a manual calculation. This is achieved in two ways:
+-- 
+-- - when there is only one posting in the "from" commodity, a total price
+--   (@@) is used, and all available decimal digits are shown
+-- 
+-- - otherwise, a suitable averaged unit price (@) is applied to the relevant
+--   postings, with a display precision that is the sum of the display
+--   precisions of the two commodities being converted between.
+-- 
+-- All postings are expected to contain an explicit amount (no missing
+-- amounts) in a single commodity.  (The code used to avoid inferring prices
+-- when it had previously inferred a missing amount, but it seems harmless to
+-- do that.)
+-- 
+inferBalancingPrices :: Transaction -> Transaction
+inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'}
+  where
+    ps' = map (priceInferrerFor t BalancedVirtualPosting) $
+          map (priceInferrerFor t RegularPosting) $
+          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).
+priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
+priceInferrerFor t pt = inferprice
+  where
+    postings       = filter ((==pt).ptype) $ tpostings t
+    pmixedamounts  = map pamount postings
+    pamounts       = concatMap amounts pmixedamounts
+    pcommodities   = map acommodity pamounts
+    sumamounts     = amounts $ sum pmixedamounts -- sum normalises to one amount per commodity & price
+    sumcommodities = map acommodity sumamounts
+    sumprices      = filter (/=NoPrice) $ map aprice sumamounts
+    caninferprices = length sumcommodities == 2 && null sumprices
+
+    inferprice p@Posting{pamount=Mixed [a]}
+      | caninferprices && ptype p == pt && acommodity a == fromcommodity
+        = p{pamount=Mixed [a{aprice=conversionprice}]}
+      where
+        fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
+        conversionprice
+          | fromcount==1 = TotalPrice $ abs toamount `withPrecision` maxprecision
+          | otherwise    = UnitPrice $ abs unitprice `withPrecision` summedprecision
+          where
+            fromcount       = length $ filter ((==fromcommodity).acommodity) pamounts
+            fromamount      = head $ filter ((==fromcommodity).acommodity) sumamounts
+            tocommodity     = head $ filter (/=fromcommodity) sumcommodities
+            toamount        = head $ filter ((==tocommodity).acommodity) sumamounts
+            unitprice       = toamount `divideAmount` (aquantity fromamount)
+            summedprecision = (asprecision $ astyle $ toamount) + (asprecision $ astyle $ fromamount)
+    inferprice p = p
 
 -- Get a transaction's secondary date, defaulting to the primary date.
 transactionDate2 :: Transaction -> Day