journal: infer and balance amounts with standard amount styles (fix #737)

Inferred amounts now have the appropriate standard amount style applied.
And when checking for balanced transactions, amount styles declared with
commodity directives are also used (previously only inferred amount styles were).

hledger-lib/Hledger/Data/Amount.hs

@@ -61,6 +61,7 @@ module Hledger.Data.Amount (
   amountValue,
   -- ** rendering
   amountstyle,
+  styleAmount,
   showAmount,
   cshowAmount,
   showAmountWithZeroCommodity,
@@ -93,6 +94,7 @@ module Hledger.Data.Amount (
   isReallyZeroMixedAmountCost,
   mixedAmountValue,
   -- ** rendering
+  styleMixedAmount,
   showMixedAmount,
   showMixedAmountOneLine,
   showMixedAmountDebug,
@@ -131,8 +133,14 @@ import Hledger.Utils
 
 deriving instance Show MarketPrice
 
+
+-------------------------------------------------------------------------------
+-- Amount styles
+
+-- | Default amount style 
 amountstyle = AmountStyle L False 0 (Just '.') Nothing
 
+
 -------------------------------------------------------------------------------
 -- Amount
 
@@ -265,6 +273,14 @@ showPriceDebug NoPrice         = ""
 showPriceDebug (UnitPrice pa)  = " @ "  ++ showAmountDebug pa
 showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa
 
+-- | Given a map of standard amount display styles, apply the appropriate one to this amount.
+-- If there's no standard style for this amount's commodity, return the amount unchanged.
+styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
+styleAmount styles a =
+  case M.lookup (acommodity a) styles of
+    Just s  -> a{astyle=s}
+    Nothing -> a 
+
 -- | Get the string representation of an amount, based on its
 -- commodity's display settings. String representations equivalent to
 -- zero are converted to just \"0\". The special "missing" amount is
@@ -555,6 +571,10 @@ isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount
 --     where a' = normaliseMixedAmountSquashPricesForDisplay a
 --           b' = normaliseMixedAmountSquashPricesForDisplay b
 
+-- | Given a map of standard amount display styles, apply the appropriate ones to each individual amount.
+styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
+styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as 
+
 -- | Get the string representation of a mixed amount, after
 -- normalising it to one amount per commodity. Assumes amounts have
 -- no or similar prices, otherwise this can show misleading prices.
@@ -648,6 +668,7 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl
 mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount
 mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as
 
+
 -------------------------------------------------------------------------------
 -- misc
 

hledger-lib/Hledger/Data/Journal.hs

@@ -19,6 +19,7 @@ module Hledger.Data.Journal (
   journalBalanceTransactions,
   journalApplyCommodityStyles,
   commodityStylesFromAmounts,
+  journalCommodityStyles,
   journalConvertAmountsToCost,
   journalFinalise,
   journalPivot,
@@ -592,7 +593,7 @@ journalBalanceTransactionsST assrt j createStore storeIn extract =
     let env = Env bals 
                   (storeIn txStore) 
                   assrt
-                  (Just $ jinferredcommodities j)
+                  (Just $ journalCommodityStyles j)
     flip R.runReaderT env $ do
       dated <- fmap snd . sortBy (comparing fst) . concat
                 <$> mapM' discriminateByDate (jtxns j)
@@ -722,7 +723,6 @@ storeTransaction tx = liftModifier $ ($tx) . eStoreTx
 liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a
 liftModifier f = R.ask >>= lift . lift . f
 
-
 -- | Choose and apply a consistent display format to the posting
 -- amounts in each commodity. Each commodity's format is specified by
 -- a commodity format directive, or otherwise inferred from posting
@@ -731,28 +731,20 @@ journalApplyCommodityStyles :: Journal -> Journal
 journalApplyCommodityStyles j@Journal{jtxns=ts, jmarketprices=mps} = j''
     where
       j' = journalInferCommodityStyles j
+      styles = journalCommodityStyles j'
       j'' = j'{jtxns=map fixtransaction ts, jmarketprices=map fixmarketprice mps}
       fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
-      fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
+      fixposting p@Posting{pamount=a} = p{pamount=styleMixedAmount styles a}
-      fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=fixamount a}
+      fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a}
-      fixmixedamount (Mixed as) = Mixed $ map fixamount as
-      fixamount a@Amount{acommodity=c} = a{astyle=journalCommodityStyle j' c}
 
--- | Get this journal's standard display style for the given
+-- | Get all the amount styles defined in this journal, either 
--- commodity.  That is the style defined by the last corresponding
+-- declared by a commodity directive (preferred) or inferred from amounts,
--- commodity format directive if any, otherwise the style inferred
+-- as a map from symbol to style. 
--- from the posting amounts (or in some cases, price amounts) in this
+journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
--- commodity if any, otherwise the default style.
+journalCommodityStyles j = declaredstyles <> inferredstyles
-journalCommodityStyle :: Journal -> CommoditySymbol -> AmountStyle
+  where
-journalCommodityStyle j = fromMaybe amountstyle{asprecision=2} . journalCommodityStyleLookup j
+    declaredstyles = M.mapMaybe cformat $ jcommodities j
-
+    inferredstyles = jinferredcommodities j
-journalCommodityStyleLookup :: Journal -> CommoditySymbol -> Maybe AmountStyle
-journalCommodityStyleLookup j c =
-  listToMaybe $
-  catMaybes [
-     M.lookup c (jcommodities j) >>= cformat
-    ,M.lookup c $ jinferredcommodities j
-    ]
 
 -- | Infer a display format for each commodity based on the amounts parsed.
 -- "hledger... will use the format of the first posting amount in the
@@ -760,8 +752,8 @@ journalCommodityStyleLookup j c =
 journalInferCommodityStyles :: Journal -> Journal
 journalInferCommodityStyles j =
   j{jinferredcommodities =
-        commodityStylesFromAmounts $
+    commodityStylesFromAmounts $
-        dbg8 "journalChooseCommmodityStyles using amounts" $ journalAmounts j}
+    dbg8 "journalInferCommmodityStyles using amounts" $ journalAmounts j}
 
 -- | Given a list of amounts in parse order, build a map from their commodity names
 -- to standard commodity display formats.
@@ -817,10 +809,8 @@ journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
       fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
       fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
       fixmixedamount (Mixed as) = Mixed $ map fixamount as
-      fixamount = applyJournalStyle . costOfAmount
+      fixamount = styleAmount styles . costOfAmount
-      applyJournalStyle a
+      styles = journalCommodityStyles j
-          | Just s <- journalCommodityStyleLookup j (acommodity a) = a{astyle=s}
-          | otherwise = a
 
 -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
 -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol

hledger-lib/Hledger/Data/Transaction.hs

@@ -278,7 +278,7 @@ tests_inference = [
     "inferBalancingAmount" ~: do
     let p `gives` p' = assertEqual (show p) (Right p') $ inferTransaction p
         inferTransaction :: Transaction -> Either String Transaction
-        inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ())
+        inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty
     nulltransaction `gives` nulltransaction
     nulltransaction{
       tpostings=[
@@ -382,11 +382,11 @@ balanceTransactionUpdate :: MonadError String m
      -- ^ update function
   -> Maybe (Map.Map CommoditySymbol AmountStyle)
   -> Transaction -> m Transaction
-balanceTransactionUpdate update styles t =
+balanceTransactionUpdate update mstyles t =
-  finalize =<< inferBalancingAmount update t
+  finalize =<< inferBalancingAmount update (fromMaybe Map.empty mstyles) t
   where
     finalize t' = let t'' = inferBalancingPrices t'
-                  in if isTransactionBalanced styles t''
+                  in if isTransactionBalanced mstyles t''
                      then return $ txnTieKnot t''
                      else throwError $ printerr $ nonzerobalanceerror t''
     printerr s = intercalate "\n" [s, showTransactionUnelided t]
@@ -409,11 +409,12 @@ balanceTransactionUpdate update styles t =
 -- 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 :: MonadError String m
+inferBalancingAmount :: MonadError String m =>
-                     => (AccountName -> MixedAmount -> m ())
+                        (AccountName -> MixedAmount -> m ()) -- ^ update function
-                     -- ^ update function
+                     -> Map.Map CommoditySymbol AmountStyle  -- ^ standard amount styles
-                     -> Transaction -> m Transaction
+                     -> Transaction
-inferBalancingAmount update t@Transaction{tpostings=ps}
+                     -> m Transaction
+inferBalancingAmount update styles t@Transaction{tpostings=ps}
   | length amountlessrealps > 1
       = throwError $ 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
@@ -432,8 +433,13 @@ inferBalancingAmount update t@Transaction{tpostings=ps}
     inferamount p@Posting{ptype=BalancedVirtualPosting}
      | not (hasAmount p) = updateAmount p bvsum
     inferamount p = return p
-    updateAmount p amt = update (paccount p) amt' >> return p { pamount=amt', porigin=Just $ originalPosting p }
+    updateAmount p amt = 
-      where amt' = normaliseMixedAmount $ costOfMixedAmount (-amt)
+      update (paccount p) amt' >> return p { pamount=amt', porigin=Just $ originalPosting p }
+      where
+        -- Inferred amounts are converted to cost.
+        -- Also, ensure the new amount has the standard style for its commodity  
+        -- (the main amount styling pass happened before this balancing pass).   
+        amt' = styleMixedAmount styles $ normaliseMixedAmount $ costOfMixedAmount (-amt)
 
 -- | Infer prices for this transaction's posting amounts, if needed to make
 -- the postings balance, and if possible. This is done once for the real

hledger-lib/Hledger/Data/Types.hs

@@ -302,7 +302,7 @@ data Journal = Journal {
   -- principal data
   ,jaccounts              :: [(AccountName, Maybe AccountCode)]     -- ^ accounts that have been declared by account directives
   ,jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives
-  ,jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts
+  ,jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts  XXX misnamed
   ,jmarketprices          :: [MarketPrice]
   ,jmodifiertxns          :: [ModifierTransaction]
   ,jperiodictxns          :: [PeriodicTransaction]

tests/budget/budget.test

@@ -95,14 +95,14 @@ Balance changes in 2016/12/01-2016/12/03:
 $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
 Balance changes in 2016/12/01-2016/12/03:
 
-                       ||                 2016/12/01                       2016/12/02                2016/12/03 
+                       ||                 2016/12/01                     2016/12/02                2016/12/03 
-=======================++=======================================================================================
+=======================++=====================================================================================
- <unbudgeted>:expenses ||         0                                0                       $40                  
+ <unbudgeted>:expenses ||         0                              0                       $40                  
- assets:cash           ||      $-15 [  60% of  $-25]          $-26.0 [ 104% of  $-25]     $-51 [ 204% of  $-25] 
+ assets:cash           ||      $-15 [  60% of  $-25]          $-26 [ 104% of  $-25]     $-51 [ 204% of  $-25] 
- expenses:food         ||       £10 [ 150% of   $10]          20 CAD [ 210% of   $10]      $11 [ 110% of   $10] 
+ expenses:food         ||       £10 [ 150% of   $10]        20 CAD [ 210% of   $10]      $11 [ 110% of   $10] 
- expenses:leisure      ||         0 [   0% of   $15]              $5 [  33% of   $15]        0 [   0% of   $15] 
+ expenses:leisure      ||         0 [   0% of   $15]            $5 [  33% of   $15]        0 [   0% of   $15] 
------------------------++---------------------------------------------------------------------------------------
+-----------------------++-------------------------------------------------------------------------------------
-                       || $-15, £10 [   0% of     0]  $-21.0, 20 CAD [   0% of     0]        0 [   0% of     0] 
+                       || $-15, £10 [   0% of     0]  $-21, 20 CAD [   0% of     0]        0 [   0% of     0] 
 # TODO zero totals ^
 
 <

tests/journal/precision.test

@@ -14,24 +14,9 @@ hledger -f - print
 
 >>>=0
 
-## 1b. here $'s canonical display precision should be 2 not 4
+# 2. here the price should be printed with its original precision, not
-## XXX no, because the inferred amount $1.0049 is observed
+# the canonical display precision. And the inferred amount should be printed
-# hledger -f - print --cost
+# with the canonical precision (2 digits, inferred from the first posting).
-# <<<
-# 2010/1/1
-#    a  $0.00
-#    a  1C @ $1.0049
-#    a
-# >>>
-# 2010/01/01
-#     a             0
-#     a         $1.00
-#     a        $-1.00
-#
-# >>>=0
-
-# 2. and here the price should be printed with its original precision, not
-# the canonical display precision
 hledger -f - print --explicit
 <<<
 2010/1/1
@@ -42,7 +27,7 @@ hledger -f - print --explicit
 2010/01/01
     a               0
     a    1C @ $1.0049
-    a        $-1.0049
+    a          $-1.00
 
 >>>=0