From 3d4f5600ae12a3a5a08883245cc839880054ad60 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 20 Apr 2018 12:18:28 -0700 Subject: [PATCH] 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 | 21 ++++++++++++ hledger-lib/Hledger/Data/Journal.hs | 44 ++++++++++--------------- hledger-lib/Hledger/Data/Transaction.hs | 28 +++++++++------- hledger-lib/Hledger/Data/Types.hs | 2 +- tests/budget/budget.test | 16 ++++----- tests/journal/precision.test | 23 +++---------- 6 files changed, 68 insertions(+), 66 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index e3b3d18ce..a1fe1680d 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/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 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 309b970fb..ef50d6571 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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} - fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=fixamount a} - fixmixedamount (Mixed as) = Mixed $ map fixamount as - fixamount a@Amount{acommodity=c} = a{astyle=journalCommodityStyle j' c} + fixposting p@Posting{pamount=a} = p{pamount=styleMixedAmount styles a} + fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a} --- | Get this journal's standard display style for the given --- commodity. That is the style defined by the last corresponding --- commodity format directive if any, otherwise the style inferred --- from the posting amounts (or in some cases, price amounts) in this --- commodity if any, otherwise the default style. -journalCommodityStyle :: Journal -> CommoditySymbol -> AmountStyle -journalCommodityStyle j = fromMaybe amountstyle{asprecision=2} . journalCommodityStyleLookup j - -journalCommodityStyleLookup :: Journal -> CommoditySymbol -> Maybe AmountStyle -journalCommodityStyleLookup j c = - listToMaybe $ - catMaybes [ - M.lookup c (jcommodities j) >>= cformat - ,M.lookup c $ jinferredcommodities j - ] +-- | Get all the amount styles defined in this journal, either +-- declared by a commodity directive (preferred) or inferred from amounts, +-- as a map from symbol to style. +journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle +journalCommodityStyles j = declaredstyles <> inferredstyles + where + declaredstyles = M.mapMaybe cformat $ jcommodities j + inferredstyles = 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 $ - dbg8 "journalChooseCommmodityStyles using amounts" $ journalAmounts j} + commodityStylesFromAmounts $ + 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 - applyJournalStyle a - | Just s <- journalCommodityStyleLookup j (acommodity a) = a{astyle=s} - | otherwise = a + fixamount = styleAmount styles . costOfAmount + styles = journalCommodityStyles j -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ba74ae1c6..2f22446ab 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/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 = - finalize =<< inferBalancingAmount update t +balanceTransactionUpdate update mstyles 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 - => (AccountName -> MixedAmount -> m ()) - -- ^ update function - -> Transaction -> m Transaction -inferBalancingAmount update t@Transaction{tpostings=ps} +inferBalancingAmount :: MonadError String m => + (AccountName -> MixedAmount -> m ()) -- ^ update function + -> Map.Map CommoditySymbol AmountStyle -- ^ standard amount styles + -> Transaction + -> 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 } - where amt' = normaliseMixedAmount $ costOfMixedAmount (-amt) + updateAmount p 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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index f38a2fdcd..b2a05e0d0 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/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] diff --git a/tests/budget/budget.test b/tests/budget/budget.test index 7a8a9ba62..33775f9ac 100644 --- a/tests/budget/budget.test +++ b/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 -=======================++======================================================================================= - :expenses || 0 0 $40 - assets:cash || $-15 [ 60% of $-25] $-26.0 [ 104% of $-25] $-51 [ 204% of $-25] - 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] ------------------------++--------------------------------------------------------------------------------------- - || $-15, £10 [ 0% of 0] $-21.0, 20 CAD [ 0% of 0] 0 [ 0% of 0] + || 2016/12/01 2016/12/02 2016/12/03 +=======================++===================================================================================== + :expenses || 0 0 $40 + 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:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] +-----------------------++------------------------------------------------------------------------------------- + || $-15, £10 [ 0% of 0] $-21, 20 CAD [ 0% of 0] 0 [ 0% of 0] # TODO zero totals ^ < diff --git a/tests/journal/precision.test b/tests/journal/precision.test index 268052813..da735eea8 100644 --- a/tests/journal/precision.test +++ b/tests/journal/precision.test @@ -14,24 +14,9 @@ hledger -f - print >>>=0 -## 1b. here $'s canonical display precision should be 2 not 4 -## XXX no, because the inferred amount $1.0049 is observed -# hledger -f - print --cost -# <<< -# 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 +# 2. here the price should be printed with its original precision, not +# the canonical display precision. And the inferred amount should be printed +# with the canonical precision (2 digits, inferred from the first posting). 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