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