From c13c13ab1ff1382de33a53df583b2ecb85786bdc Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 19 Sep 2023 07:54:25 +0100 Subject: [PATCH] lib!: use styleAmounts in more places; add rounding strategies --- hledger-lib/Hledger/Data/Amount.hs | 280 +++++++++--------- hledger-lib/Hledger/Data/Balancing.hs | 8 +- hledger-lib/Hledger/Data/Journal.hs | 8 +- hledger-lib/Hledger/Data/Posting.hs | 32 +- .../Hledger/Data/TransactionModifier.hs | 4 +- hledger-lib/Hledger/Data/Types.hs | 17 +- hledger-lib/Hledger/Data/Valuation.hs | 4 +- hledger-lib/Hledger/Read/Common.hs | 2 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 2 +- hledger/Hledger/Cli/Commands/Balance.hs | 2 +- hledger/Hledger/Cli/Commands/Prices.hs | 2 +- hledger/Hledger/Cli/Commands/Register.hs | 2 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 3 +- 13 files changed, 193 insertions(+), 173 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index c18d780e3..d8c0389fc 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -48,7 +48,9 @@ module Hledger.Data.Amount ( showCommoditySymbol, isNonsimpleCommodityChar, quoteCommoditySymbolIfNeeded, + -- * Amount + -- ** arithmetic nullamt, missingamt, num, @@ -60,27 +62,25 @@ module Hledger.Data.Amount ( at, (@@), amountWithCommodity, - -- ** arithmetic amountCost, amountIsZero, amountLooksZero, divideAmount, multiplyAmount, + -- ** styles + amountstyle, + canonicaliseAmount, + styleAmount, + amountSetStyles, + amountStyleSetRounding, + amountStylesSetRounding, + amountUnstyled, -- ** rendering AmountDisplayOpts(..), noColour, noPrice, oneLine, csvDisplay, - amountstyle, - canonicaliseAmount, - styleAmount, - amountSetStyles, - amountSetStylesExceptPrecision, - amountSetMainStyle, - amountSetCostStyle, - amountStyleSetRounding, - amountUnstyled, showAmountB, showAmount, showAmountPrice, @@ -97,6 +97,7 @@ module Hledger.Data.Amount ( setAmountDecimalPoint, withDecimalPoint, amountStripPrices, + -- * MixedAmount nullmixedamt, missingmixedamt, @@ -129,12 +130,12 @@ module Hledger.Data.Amount ( maIsZero, maIsNonZero, mixedAmountLooksZero, - -- ** rendering + -- ** styles canonicaliseMixedAmount, styleMixedAmount, mixedAmountSetStyles, - mixedAmountSetStylesExceptPrecision, mixedAmountUnstyled, + -- ** rendering showMixedAmount, showMixedAmountOneLine, showMixedAmountDebug, @@ -148,6 +149,7 @@ module Hledger.Data.Amount ( wbUnpack, mixedAmountSetPrecision, mixedAmountSetFullPrecision, + -- * misc. tests_Amount ) where @@ -179,6 +181,7 @@ import Hledger.Utils (colorB, numDigitsInt) import Hledger.Utils.Text (textQuoteIfNeeded) import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack) import Data.Functor ((<&>)) +-- import Hledger.Utils.Debug (dbg0) -- A 'Commodity' is a symbol representing a currency or some other kind of @@ -246,15 +249,7 @@ csvDisplay :: AmountDisplayOpts csvDisplay = oneLine{displayThousandsSep=False} ------------------------------------------------------------------------------- --- Amount styles - --- | Default amount style -amountstyle = AmountStyle L False Nothing (Just '.') (Precision 0) NoRounding - -------------------------------------------------------------------------------- --- Amount - -instance HasAmounts Amount where styleAmounts = amountSetStyles +-- Amount arithmetic instance Num Amount where abs a@Amount{aquantity=q} = a{aquantity=abs q} @@ -409,6 +404,123 @@ setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{ withInternalPrecision :: Amount -> Word8 -> Amount withInternalPrecision = flip setAmountInternalPrecision +-- Amount display styles + +-- v1 +{-# DEPRECATED canonicaliseAmount "please use styleAmounts instead" #-} +canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount +canonicaliseAmount = styleAmounts + +-- v2 +{-# DEPRECATED styleAmount "please use styleAmounts instead" #-} +styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount +styleAmount = styleAmounts + +-- v3 +{-# DEPRECATED amountSetStyles "please use styleAmounts instead" #-} +amountSetStyles :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount +amountSetStyles = styleAmounts + +-- v4 +instance HasAmounts Amount where + -- | Given some commodity display styles, find and apply the appropriate one to this amount, + -- and its cost amount if any (and stop; we assume costs don't have costs). + -- Display precision will be applied (or not) as specified by the style's rounding strategy, + -- except that costs' precision is never changed (costs are often recorded inexactly, + -- so we don't want to imply greater precision than they were recorded with). + -- If no style is found for an amount, it is left unchanged. + styleAmounts styles a@Amount{aquantity=qty, acommodity=comm, astyle=oldstyle, aprice=mcost0} = + a{astyle=newstyle, aprice=mcost1} + where + newstyle = mknewstyle False qty oldstyle comm + + mcost1 = case mcost0 of + Nothing -> Nothing + Just (UnitPrice ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ UnitPrice ca{astyle=mknewstyle True cq cs ccomm} + Just (TotalPrice ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ TotalPrice ca{astyle=mknewstyle True cq cs ccomm} + + mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle + mknewstyle iscost oldq olds com = + case M.lookup com styles of + Just s -> + -- dbg0 "new style" $ + amountStyleApplyWithRounding iscost oldq + ( + -- dbg0 "applying style" + s) + ( + -- dbg0 "old style" + olds) + Nothing -> olds + +-- AmountStyle helpers + +-- | Replace one AmountStyle with another, but don't just replace the display precision; +-- update that in one of several ways as selected by the new style's "rounding strategy": +-- +-- NoRounding - keep the precision unchanged +-- +-- SoftRounding - +-- +-- if either precision is NaturalPrecision, use NaturalPrecision; +-- +-- if the new precision is greater than the old, use the new (adds decimal zeros); +-- +-- if the new precision is less than the old, use as close to the new as we can get +-- without dropping (more) non-zero digits (drops decimal zeros). +-- +-- for a cost amount, keep the precision unchanged +-- +-- HardRounding - +-- +-- for a posting amount, use the new precision (may truncate significant digits); +-- +-- for a cost amount, keep the precision unchanged +-- +-- AllRounding - +-- +-- for both posting and cost amounts, do hard rounding. +-- +-- Arguments: +-- +-- whether this style is for a posting amount or a cost amount, +-- +-- the amount's decimal quantity (for inspecting its internal representation), +-- +-- the new style, +-- +-- the old style. +-- +amountStyleApplyWithRounding :: Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle +amountStyleApplyWithRounding iscost q news@AmountStyle{asprecision=newp, asrounding=newr} AmountStyle{asprecision=oldp} = + case newr of + NoRounding -> news{asprecision=oldp} + SoftRounding -> news{asprecision=if iscost then oldp else newp'} + where + newp' = case (newp, oldp) of + (Precision new, Precision old) -> + if new >= old + then Precision new + else Precision $ max (min old internal) new + where internal = decimalPlaces $ normalizeDecimal q + _ -> NaturalPrecision + HardRounding -> news{asprecision=if iscost then oldp else newp} + AllRounding -> news + +-- | Set this amount style's rounding strategy when being applied to amounts. +amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle +amountStyleSetRounding r as = as{asrounding=r} + +amountStylesSetRounding :: Rounding -> M.Map CommoditySymbol AmountStyle -> M.Map CommoditySymbol AmountStyle +amountStylesSetRounding r = M.map (amountStyleSetRounding r) + +-- | Default amount style +amountstyle = AmountStyle L False Nothing (Just '.') (Precision 0) NoRounding + +-- | Reset this amount's display style to the default. +amountUnstyled :: Amount -> Amount +amountUnstyled a = a{astyle=amountstyle} + -- | Set (or clear) an amount's display decimal point. setAmountDecimalPoint :: Maybe Char -> Amount -> Amount setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalmark=mc} } @@ -417,6 +529,8 @@ setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalmark=mc} } withDecimalPoint :: Amount -> Maybe Char -> Amount withDecimalPoint = flip setAmountDecimalPoint +-- Amount rendering + -- | Strip all prices from an Amount amountStripPrices :: Amount -> Amount amountStripPrices a = a{aprice=Nothing} @@ -433,103 +547,6 @@ showAmountPriceDebug Nothing = "" showAmountPriceDebug (Just (UnitPrice pa)) = " @ " ++ showAmountDebug pa showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa --- Amount styling --- v1 - --- like journalCanonicaliseAmounts --- | Canonicalise an amount's display style using the provided commodity style map. --- Its cost amount, if any, is not affected. -canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -canonicaliseAmount = amountSetMainStyle -{-# DEPRECATED canonicaliseAmount "please use amountSetMainStyle (or amountSetStyles) instead" #-} - --- v2 - --- | Given a map of standard commodity display styles, apply the --- appropriate one to this amount. If there's no standard style for --- this amount's commodity, return the amount unchanged. --- Also do the same for the cost amount if any, but leave its precision unchanged. -styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -styleAmount = amountSetStyles -{-# DEPRECATED styleAmount "please use amountSetStyles instead" #-} - --- v3 - --- | Given some commodity display styles, find and apply the appropriate --- display style to this amount, and do the same for its cost amount if any --- (and then stop; we assume costs don't have costs). --- The main amount's display precision is set or not, according to its style; --- the cost amount's display precision is left unchanged, regardless of its style. --- If no style is found for an amount, it is left unchanged. -amountSetStyles :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -amountSetStyles styles = amountSetMainStyle styles <&> amountSetCostStyle styles - --- | Like amountSetStyles, but leave the display precision unchanged --- in both main and cost amounts. -amountSetStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -amountSetStylesExceptPrecision styles a@Amount{astyle=AmountStyle{asprecision=origp}} = - case M.lookup (acommodity a) styles' of - Just s -> a{astyle=s{asprecision=origp}} - Nothing -> a - where styles' = M.map (amountStyleSetRounding NoRounding) styles - -amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle -amountStyleSetRounding r as = as{asrounding=r} - --- | Find and apply the appropriate display style, if any, to this amount. --- The display precision is adjusted or not, as determnined by the style's rounding strategy. -amountSetMainStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -amountSetMainStyle styles a@Amount{aquantity=q, acommodity=comm, astyle=s0} = - case M.lookup comm styles of - Nothing -> a - Just s -> a{astyle=amountStyleApplyPrecision q s s0} - --- | A helper for updating an Amount's display precision, more carefully than amountSetPrecision. --- Given an Amount's decimal quantity (for inspecting its internal representation), --- its current display style, and a new display style, --- apply the new style's display precision to the old style, --- using the new style's rounding strategy, as follows: --- --- NoRounding - the precision is left unchanged --- --- SoftRounding - --- --- if either precision is NaturalPrecision, use NaturalPrecision; --- --- if the new precision is greater than the old, use the new (adds decimal zeros); --- --- if the new precision is less than the old, use as close to the new as we can get --- without dropping (more) non-zero digits (drops decimal zeros). --- -amountStyleApplyPrecision :: Quantity -> AmountStyle -> AmountStyle -> AmountStyle -amountStyleApplyPrecision q AmountStyle{asprecision=newp, asrounding=r} s@AmountStyle{asprecision=oldp} = - case r of - NoRounding -> s - SoftRounding -> s{asprecision=p} - where - p = case (newp, oldp) of - (Precision new, Precision old) -> - if new >= old - then Precision new - else Precision $ max (min old internal) new - where internal = decimalPlaces $ normalizeDecimal q - _ -> NaturalPrecision - --- | Find and apply the appropriate display style, if any, to this amount's cost, if any. --- The display precision is left unchanged, regardless of the style. -amountSetCostStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -amountSetCostStyle styles a@Amount{aprice=mcost} = - case mcost of - Nothing -> a - Just (UnitPrice a2) -> a{aprice=Just $ UnitPrice $ amountSetStylesExceptPrecision styles a2} - Just (TotalPrice a2) -> a{aprice=Just $ TotalPrice $ amountSetStylesExceptPrecision styles a2} - - --- | Reset this amount's display style to the default. -amountUnstyled :: Amount -> Amount -amountUnstyled a = a{astyle=amountstyle} - - -- | 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 @@ -641,8 +658,6 @@ applyDigitGroupStyle (Just (DigitGroups c (g0:gs0))) l0 s0 = addseps (g0:|gs0) ( ------------------------------------------------------------------------------- -- MixedAmount -instance HasAmounts MixedAmount where styleAmounts = mixedAmountSetStyles - instance Semigroup MixedAmount where (<>) = maPlus sconcat = maSum @@ -901,35 +916,34 @@ mixedAmountCost (Mixed ma) = -- where a' = mixedAmountStripPrices a -- b' = mixedAmountStripPrices b --- Mixed amount styling --- v1 +-- Mixed amount styles --- | Canonicalise a mixed amount's display styles using the provided commodity style map. --- Cost amounts, if any, are not affected. +-- v1 +{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetStyle False (or styleAmounts) instead" #-} canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles) -{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetMainStyle (or mixedAmountSetStyles) instead" #-} +canonicaliseMixedAmount = styleAmounts -- v2 - +{-# DEPRECATED styleMixedAmount "please use styleAmounts instead" #-} -- | Given a map of standard commodity display styles, find and apply -- the appropriate style to each individual amount. styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -styleMixedAmount = mixedAmountSetStyles -{-# DEPRECATED styleMixedAmount "please use mixedAmountSetStyles instead" #-} +styleMixedAmount = styleAmounts -- v3 - +{-# DEPRECATED mixedAmountSetStyles "please use styleAmounts instead" #-} mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -mixedAmountSetStyles styles = mapMixedAmountUnsafe (amountSetStyles styles) +mixedAmountSetStyles = styleAmounts -mixedAmountSetStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -mixedAmountSetStylesExceptPrecision styles = mapMixedAmountUnsafe (amountSetStylesExceptPrecision styles) +-- v4 +instance HasAmounts MixedAmount where + styleAmounts styles = mapMixedAmountUnsafe (styleAmounts styles) -- | Reset each individual amount's display style to the default. mixedAmountUnstyled :: MixedAmount -> MixedAmount mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled +-- Mixed amount rendering -- | Get the string representation of a mixed amount, after -- normalising it to one amount per commodity. Assumes amounts have diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index f773eef6f..4e6c7fa01 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -101,7 +101,7 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs VirtualPosting -> (l, r) -- check for mixed signs, detecting nonzeros at display precision - setstyles = maybe id mixedAmountSetStyles commodity_styles_ + setstyles = maybe id styleAmounts commodity_styles_ postingBalancingAmount p | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p | otherwise = mixedAmountCost $ pamount p @@ -250,7 +250,7 @@ transactionInferBalancingAmount styles t@Transaction{tpostings=ps} -- Inferred amounts are converted to cost. -- Also ensure the new amount has the standard style for its commodity -- (since the main amount styling pass happened before this balancing pass); - a' = mixedAmountSetStyles styles . mixedAmountCost $ maNegate a + a' = styleAmounts styles . mixedAmountCost $ maNegate a -- | Infer costs for this transaction's posting amounts, if needed to make -- the postings balance, and if permitted. This is done once for the real @@ -453,7 +453,9 @@ journalBalanceTransactions bopts' j' = -- ensure transactions are numbered, so we can store them by number j@Journal{jtxns=ts} = journalNumberTransactions j' -- display precisions used in balanced checking - styles = Just $ journalCommodityStyles j + styles = Just $ + journalCommodityStylesWith HardRounding -- txn balancedness will be checked using commodity display precisions + j bopts = bopts'{commodity_styles_=styles} -- XXX ^ The commodity directive styles and default style and inferred styles -- are merged into the command line styles in commodity_styles_ - why ? diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index f45d3bc4f..bd79bbb91 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -26,6 +26,7 @@ module Hledger.Data.Journal ( journalStyleAmounts, commodityStylesFromAmounts, journalCommodityStyles, + journalCommodityStylesWith, journalToCost, journalInferEquityFromCosts, journalInferCostsFromEquity, @@ -802,7 +803,7 @@ journalStyleAmounts :: Journal -> Either String Journal journalStyleAmounts = fmap journalapplystyles . journalInferCommodityStyles where journalapplystyles j@Journal{jpricedirectives=pds} = - journalMapPostings (postingStyleAmounts styles) j{jpricedirectives=map fixpricedirective pds} + journalMapPostings (styleAmounts styles) j{jpricedirectives=map fixpricedirective pds} where styles = journalCommodityStylesWith NoRounding j -- defer rounding, in case of print --round=none fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmounts styles a} @@ -824,6 +825,11 @@ journalCommodityStyles j = defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j] inferredstyles = jinferredcommodities j +-- | Like journalCommodityStyles, but attach a particular rounding strategy to the styles, +-- affecting how they will affect display precisions when applied. +journalCommodityStylesWith :: Rounding -> Journal -> M.Map CommoditySymbol AmountStyle +journalCommodityStylesWith r = amountStylesSetRounding r . journalCommodityStyles + -- | Collect and save inferred amount styles for each commodity based on -- the posting amounts in that commodity (excluding price amounts), ie: -- "the format of the first amount, adjusted to the highest precision of all amounts". diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 1f2e2c90d..7ee8ca0ac 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -39,7 +39,7 @@ module Hledger.Data.Posting ( postingStripPrices, postingApplyAliases, postingApplyCommodityStyles, - postingApplyCommodityStylesExceptPrecision, + postingStyleAmounts, postingAddTags, -- * date operations postingDate, @@ -107,6 +107,19 @@ instance HasAmounts Posting where ,pbalanceassertion=styleAmounts styles pbalanceassertion } +{-# DEPRECATED postingApplyCommodityStyles "please use styleAmounts instead" #-} +-- | Find and apply the appropriate display style to the posting amounts +-- in each commodity (see journalCommodityStyles). +-- Main amount precisions may be set or not according to the styles, but cost precisions are not set. +postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting +postingApplyCommodityStyles = styleAmounts + +{-# DEPRECATED postingStyleAmounts "please use styleAmounts instead" #-} +-- | Like postingApplyCommodityStyles, but neither +-- main amount precisions or cost precisions are set. +postingStyleAmounts :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting +postingStyleAmounts = styleAmounts + nullposting, posting :: Posting nullposting = Posting {pdate=Nothing @@ -419,23 +432,6 @@ postingApplyAliases aliases p@Posting{paccount} = err = "problem while applying account aliases:\n" ++ pshow aliases ++ "\n to account name: "++T.unpack paccount++"\n "++e --- | Find and apply the appropriate display style to the posting amounts --- in each commodity (see journalCommodityStyles). --- Main amount precisions may be set or not according to the styles, but cost precisions are not set. -postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting -postingApplyCommodityStyles styles p = p{pamount=mixedAmountSetStyles styles $ pamount p - ,pbalanceassertion=balanceassertionsetstyles <$> pbalanceassertion p} - where - balanceassertionsetstyles ba = ba{baamount=amountSetStyles styles $ baamount ba} - --- | Like postingApplyCommodityStyles, but neither --- main amount precisions or cost precisions are set. -postingApplyCommodityStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting -postingApplyCommodityStylesExceptPrecision styles p = p{pamount=mixedAmountSetStylesExceptPrecision styles $ pamount p - ,pbalanceassertion=balanceassertionsetstyles <$> pbalanceassertion p} - where - balanceassertionsetstyles ba = ba{baamount=amountSetStylesExceptPrecision styles $ baamount ba} - -- | Add tags to a posting, discarding any for which the posting already has a value. postingAddTags :: Posting -> [Tag] -> Posting postingAddTags p@Posting{ptags} tags = p{ptags=ptags `union` tags} diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 65225fd4b..0fd485719 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -25,7 +25,7 @@ import Hledger.Data.Dates import Hledger.Data.Transaction (txnTieKnot) import Hledger.Query (Query, filterQuery, matchesAmount, matchesPostingExtra, parseQuery, queryIsAmt, queryIsSym, simplifyQuery) -import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags, postingApplyCommodityStyles) +import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags) import Hledger.Utils (dbg6, wrap) -- $setup @@ -109,7 +109,7 @@ transactionModifierToFunction atypes atags styles refdate verbosetags Transactio -- The provided TransactionModifier's query text is saved as the tags' value. tmPostingRuleToFunction :: Bool -> M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting) tmPostingRuleToFunction verbosetags styles query querytxt tmpr = - \p -> postingApplyCommodityStyles styles . renderPostingCommentDates $ pr + \p -> styleAmounts styles . renderPostingCommentDates $ pr { pdate = pdate pr <|> pdate p , pdate2 = pdate2 pr <|> pdate2 p , pamount = amount' p diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 4b70e052e..f4952a9a8 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -272,6 +272,7 @@ instance Show AmountStyle where , show asdigitgroups , show asdecimalmark , show asprecision + , show asrounding ] -- | The "display precision" for a hledger amount, by which we mean @@ -281,15 +282,15 @@ data AmountPrecision = | NaturalPrecision -- ^ show all significant decimal digits stored internally deriving (Eq,Ord,Read,Show,Generic) --- | "Rounding strategy" - when applying the display precision from AmountStyle to another --- (as when applying commodity styles to amounts), how much padding or rounding --- of decimal digits should be done ? +-- | "Rounding strategy" - how to apply an AmountStyle's display precision +-- to a posting amount (and its cost, if any). +-- Mainly used to customise print's output, with --round=none|soft|hard|all. data Rounding = - NoRounding -- ^ keep the amount precisions unchanged - | SoftRounding -- ^ add or remove trailing zeros to approach the desired precision - -- | HardRounding -- ^ also remove non-zero digits, in posting amounts (lossy) - -- | HardRoundingAndCost -- ^ also remove non-zero digits, in posting and cost amounts (lossy) - deriving (Eq,Ord,Read,Generic) + NoRounding -- ^ keep display precisions unchanged in amt and cost + | SoftRounding -- ^ do soft rounding of amt and cost amounts (show more or fewer decimal zeros to approximate the target precision, but don't hide significant digits) + | HardRounding -- ^ do hard rounding of amt (use the exact target precision, possibly hiding significant digits), and soft rounding of cost + | AllRounding -- ^ do hard rounding of amt and cost + deriving (Eq,Ord,Read,Show,Generic) -- | A style for displaying digit groups in the integer part of a -- floating point number. It consists of the character used to diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 7c20110fd..6800dcb80 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -129,7 +129,7 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = -- | Convert an Amount to its cost if requested, and style it appropriately. amountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount -amountToCost styles ToCost = amountSetStyles styles . amountCost +amountToCost styles ToCost = styleAmounts styles . amountCost amountToCost _ NoConversionOp = id -- | Apply a specified valuation to this amount, using the provided @@ -192,7 +192,7 @@ amountValueAtDate priceoracle styles mto d a = -- setNaturalPrecisionUpTo 8 $ -- XXX force higher precision in case amount appears to be zero ? -- Make default display style use precision 2 instead of 0 ? -- Leave as is for now; mentioned in manual. - amountSetStyles styles + styleAmounts styles nullamt{acommodity=comm, aquantity=rate * aquantity a} -- | Calculate the gain of each component amount, that is the difference diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index c00d322b7..6974fb613 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -374,7 +374,7 @@ journalAddForecast verbosetags (Just forecastspan) j = j{jtxns = jtxns j ++ fore where {-# HLINT ignore "Move concatMap out" #-} forecasttxns = - map (txnTieKnot . transactionTransformPostings (postingApplyCommodityStyles $ journalCommodityStyles j)) + map (txnTieKnot . transactionTransformPostings (styleAmounts $ journalCommodityStyles j)) . filter (spanContainsDate forecastspan . tdate) . concatMap (\pt -> runPeriodicTransaction verbosetags pt forecastspan) $ jperiodictxns j diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 7c74f3302..f69da29d1 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -626,7 +626,7 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = gain mc spn = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn) costing = case fromMaybe NoConversionOp $ conversionop_ ropts of NoConversionOp -> id - ToCost -> mixedAmountSetStyles styles . mixedAmountCost + ToCost -> styleAmounts styles . mixedAmountCost styles = journalCommodityStyles j err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date" diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index abb227cb9..b306985fc 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -376,7 +376,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: writeOutputLazyText opts $ render ropts report where - styles = journalCommodityStyles j + styles = journalCommodityStylesWith HardRounding j ropts@ReportOpts{..} = _rsReportOpts rspec -- Tidy csv should be consistent between single period and multiperiod reports. multiperiod = interval_ /= NoInterval || (layout_ == LayoutTidy && fmt == "csv") diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index 19dfcd2d7..2735d4b2f 100644 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -78,7 +78,7 @@ invertPrice a = -- But keep the number of decimal places unchanged. stylePriceDirectiveExceptPrecision :: M.Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective stylePriceDirectiveExceptPrecision styles pd@PriceDirective{pdamount=a} = - pd{pdamount = amountSetStylesExceptPrecision styles a} + pd{pdamount = styleAmounts styles a} allPostings :: Journal -> [Posting] allPostings = concatMap tpostings . jtxns diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 499999b8e..f93bbd781 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -84,7 +84,7 @@ register opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j -- normal register report, list postings | otherwise = writeOutputLazyText opts $ render $ styleAmounts styles rpt where - styles = journalCommodityStyles j + styles = journalCommodityStylesWith HardRounding j rpt = postingsReport rspec j render | fmt=="txt" = postingsReportAsText opts | fmt=="csv" = printCSV . postingsReportAsCsv diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 7a0063d74..7e1adf707 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -110,8 +110,9 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = -- | Generate a runnable command from a compound balance command specification. compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=rspec, rawopts_=rawopts} j = do - writeOutputLazyText opts $ render $ styleAmounts (journalCommodityStyles j) cbr + writeOutputLazyText opts $ render $ styleAmounts styles cbr where + styles = journalCommodityStylesWith HardRounding j ropts@ReportOpts{..} = _rsReportOpts rspec -- use the default balance type for this report, unless the user overrides mbalanceAccumulationOverride = balanceAccumulationOverride rawopts