fix: price: Make sure inferred market prices have the correct sign with

total prices. (#1813)

Also reduce duplication for inferring market prices (previously it was
done separately in both Hledger.Data.Journal and
Hledger.Cli.Commands.Prices), and remove *TotalPriceToUnitPrice
functions, since unit prices cannot represent all total prices.

Add a helper function numDigitsInt to get the number of digits in an
integer, which has a surprising number of ways to get it wrong.

hledger-lib/Hledger/Data/Amount.hs

@@ -67,7 +67,6 @@ module Hledger.Data.Amount (
   amountLooksZero,
   divideAmount,
   multiplyAmount,
-  amountTotalPriceToUnitPrice,
   -- ** rendering
   AmountDisplayOpts(..),
   noColour,
@@ -125,7 +124,6 @@ module Hledger.Data.Amount (
   maIsZero,
   maIsNonZero,
   mixedAmountLooksZero,
-  mixedAmountTotalPriceToUnitPrice,
   -- ** rendering
   styleMixedAmount,
   mixedAmountUnstyled,
@@ -171,7 +169,7 @@ import Test.Tasty (testGroup)
 import Test.Tasty.HUnit ((@?=), assertBool, testCase)
 
 import Hledger.Data.Types
-import Hledger.Utils (colorB)
+import Hledger.Utils (colorB, numDigitsInt)
 import Hledger.Utils.Text (textQuoteIfNeeded)
 import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)
 
@@ -312,22 +310,6 @@ amountCost a@Amount{aquantity=q, aprice=mp} =
       Just (UnitPrice  p@Amount{aquantity=pq}) -> p{aquantity=pq * q}
       Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq}
 
--- | 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 keep transaction amounts balancing.
--- Does Decimal division, might be some rounding/irrational number issues.
-amountTotalPriceToUnitPrice :: Amount -> Amount
-amountTotalPriceToUnitPrice
-    a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps})}
-    = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp}}}
-  where
-    -- Increase the precision by 1, capping at the max bound.
-    pp = case asprecision ps of
-                NaturalPrecision -> NaturalPrecision
-                Precision p      -> Precision $ if p == maxBound then maxBound else p + 1
-amountTotalPriceToUnitPrice a = a
-
 -- | Apply a function to an amount's quantity (and its total price, if it has one).
 transformAmount :: (Quantity -> Quantity) -> Amount -> Amount
 transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p}
@@ -950,8 +932,8 @@ elisionDisplay mmax sep n lastAmt
   | otherwise = Nothing
   where
     fullString = T.pack $ show n ++ " more.."
-    -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number
-    fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n)
+    -- sep from the separator, 7 from " more..", numDigits n from number
+    fullLength = sep + 7 + numDigitsInt n
 
     str | Just m <- mmax, fullLength > m = T.take (m - 2) fullString <> ".."
         | otherwise                      = fullString
@@ -985,12 +967,6 @@ mixedAmountStripPrices (Mixed ma) =
 canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
 canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)
 
--- | 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 = mapMixedAmount amountTotalPriceToUnitPrice
-
 
 -------------------------------------------------------------------------------
 -- tests

hledger-lib/Hledger/Data/Journal.hs

@@ -926,26 +926,12 @@ canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=m
 journalInferMarketPricesFromTransactions :: Journal -> Journal
 journalInferMarketPricesFromTransactions j =
   j{jinferredmarketprices =
-       dbg4 "jinferredmarketprices" $
-       mapMaybe postingInferredmarketPrice $ journalPostings j
+       dbg4 "jinferredmarketprices" .
+       map priceDirectiveToMarketPrice .
+       concatMap postingPriceDirectivesFromCost $
+       journalPostings j
    }
 
--- | Make a market price equivalent to this posting's amount's unit
--- price, if any. If the posting amount is multicommodity, only the
--- first commodity amount is considered.
-postingInferredmarketPrice :: Posting -> Maybe MarketPrice
-postingInferredmarketPrice p@Posting{pamount} =
-    -- convert any total prices to unit prices
-    case amountsRaw $ mixedAmountTotalPriceToUnitPrice pamount of
-      Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->
-        Just MarketPrice {
-           mpdate = postingDate p
-          ,mpfrom = fromcomm
-          ,mpto   = tocomm
-          ,mprate = rate
-          }
-      _ -> Nothing
-
 -- | 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 :: ConversionOp -> Journal -> Journal

hledger-lib/Hledger/Data/Posting.hs

@@ -66,6 +66,7 @@ module Hledger.Data.Posting (
   postingApplyValuation,
   postingToCost,
   postingAddInferredEquityPostings,
+  postingPriceDirectivesFromCost,
   tests_Posting
 )
 where
@@ -73,7 +74,7 @@ where
 import Data.Default (def)
 import Data.Foldable (asum)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.List (foldl', sort, union)
 import qualified Data.Set as S
 import Data.Text (Text)
@@ -456,6 +457,12 @@ postingAddInferredEquityPostings equityAcct p = taggedPosting : concatMap conver
     priceTag = ("cost", T.strip . wbToText $ foldMap showAmountPrice priceAmounts)
     priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p
 
+-- | Make a market price equivalent to this posting's amount's unit
+-- price, if any.
+postingPriceDirectivesFromCost :: Posting -> [PriceDirective]
+postingPriceDirectivesFromCost p@Posting{pamount} =
+    mapMaybe (amountPriceDirectiveFromCost $ postingDate p) $ amountsRaw pamount
+
 -- | Apply a transform function to this posting's amount.
 postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
 postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a}

hledger-lib/Hledger/Data/Valuation.hs

@@ -24,6 +24,7 @@ module Hledger.Data.Valuation (
   ,mixedAmountGainAtDate
   ,marketPriceReverse
   ,priceDirectiveToMarketPrice
+  ,amountPriceDirectiveFromCost
   -- ,priceLookup
   ,tests_Valuation
 )
@@ -96,6 +97,22 @@ priceDirectiveToMarketPrice PriceDirective{..} =
              , mprate = aquantity pdamount
              }
 
+-- | Make one or more `MarketPrice` from an 'Amount' and its price directives.
+amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
+amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=fromq} = case aprice amt of
+    Just (UnitPrice pa)               -> Just $ pd{pdamount=pa}
+    Just (TotalPrice pa) | fromq /= 0 -> Just $ pd{pdamount=fromq `divideAmountExtraPrecision` pa}
+    _                                 -> Nothing
+  where
+    pd = PriceDirective{pddate = d, pdcommodity = fromcomm, pdamount = nullamt}
+
+    divideAmountExtraPrecision n a = (n `divideAmount` a) { astyle = style' }
+      where
+        style' = (astyle a) { asprecision = precision' }
+        precision' = case asprecision (astyle a) of
+                          NaturalPrecision -> NaturalPrecision
+                          Precision p      -> Precision $ (numDigitsInt $ truncate n) + p
+
 ------------------------------------------------------------------------------
 -- Converting things to value
 

hledger-lib/Hledger/Utils.hs

@@ -234,6 +234,22 @@ sequence' ms = do
 mapM' :: Monad f => (a -> f b) -> [a] -> f [b]
 mapM' f = sequence' . map f
 
+-- | Find the number of digits of an 'Int'.
+numDigitsInt :: Integral a => Int -> a
+numDigitsInt n
+    | n == minBound = 19  -- negate minBound is out of the range of Int
+    | n < 0         = go (negate n)
+    | otherwise     = go n
+  where
+    go a | a < 10                 = 1
+         | a < 100                = 2
+         | a < 1000               = 3
+         | a < 10000              = 4
+         | a >= 10000000000000000 = 16 + go (a `quot` 10000000000000000)
+         | a >= 100000000         = 8  + go (a `quot` 100000000)
+         | otherwise              = 4  + go (a `quot` 10000)
+{-# INLINE numDigitsInt #-}
+
 -- | Simpler alias for errorWithoutStackTrace
 error' :: String -> a
 error' = errorWithoutStackTrace

hledger/Hledger/Cli/Commands/Prices.hs

@@ -8,11 +8,9 @@ module Hledger.Cli.Commands.Prices (
 where
 
 import qualified Data.Map as M
-import Data.Maybe
 import Data.List
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
-import Data.Time
 import Hledger
 import Hledger.Cli.CliOptions
 import System.Console.CmdArgs.Explicit
@@ -37,10 +35,10 @@ prices opts j = do
     mprices    = jpricedirectives j
     cprices    =
       map (stylePriceDirectiveExceptPrecision styles) $
-      concatMap postingsPriceDirectivesFromCosts ps
+      concatMap postingPriceDirectivesFromCost ps
     rcprices   =
       map (stylePriceDirectiveExceptPrecision styles) $
-      concatMap (postingsPriceDirectivesFromCosts . postingTransformAmount (mapMixedAmount invertPrice))
+      concatMap (postingPriceDirectivesFromCost . postingTransformAmount (mapMixedAmount invertPrice))
       ps
     allprices  =
       mprices
@@ -58,15 +56,6 @@ prices opts j = do
 showPriceDirective :: PriceDirective -> T.Text
 showPriceDirective mp = T.unwords ["P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, wbToText . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp]
 
-divideAmount' :: Quantity -> Amount -> Amount
-divideAmount' n a = a' where
-    a' = (n `divideAmount` a) { astyle = style' }
-    style' = (astyle a) { asprecision = precision' }
-    extPrecision = (1+) . floor . logBase 10 $ (realToFrac n :: Double)
-    precision' = case asprecision (astyle a) of
-                      NaturalPrecision -> NaturalPrecision
-                      Precision p      -> Precision $ extPrecision + p
-
 -- XXX
 
 -- | Invert an amount's price for --invert-cost, somehow ? Unclear.
@@ -84,19 +73,6 @@ invertPrice a =
   where
     nonZeroSignum x = if x < 0 then -1 else 1
 
-postingsPriceDirectivesFromCosts :: Posting -> [PriceDirective]
-postingsPriceDirectivesFromCosts p = mapMaybe (amountPriceDirectiveFromCost date) . amountsRaw $ pamount p
-  where date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p
-
-amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
-amountPriceDirectiveFromCost d a =
-    case aprice a of
-        Just (UnitPrice pa) -> Just
-            PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = pa }
-        Just (TotalPrice pa) | aquantity a /= 0 -> Just
-            PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = abs (aquantity a) `divideAmount'` pa }
-        _ -> Nothing
-
 -- | Given a map of standard amount display styles, apply the
 -- appropriate one, if any, to this price directive's amount.
 -- But keep the number of decimal places unchanged.

hledger/test/prices.test

@@ -32,10 +32,15 @@ P 2016/2/1 EUR $1.05
 2016/1/3 spend
     expenses             20 EUR @@ $21.45
     assets:bank
+
+2016/1/4 spend
+    expenses            -20 EUR @@ $21.45
+    assets:bank
 $ hledger prices -f- --infer-market-prices
 P 2016-01-01 EUR $1.06
 P 2016-01-02 EUR $1.07
 P 2016-01-03 EUR $1.0725
+P 2016-01-04 EUR $1.0725
 P 2016-02-01 EUR $1.05
 
 # 3. inverted prices can be calculated