From 9f0840456d6653bf6cd2fa661c284b2c738b44e1 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 28 Aug 2023 07:26:16 +0100 Subject: [PATCH] dev: consolidate amount styling as a new (interim) api --- hledger-lib/Hledger/Data/Amount.hs | 96 +++++++++++++++----- hledger-lib/Hledger/Data/Balancing.hs | 8 +- hledger-lib/Hledger/Data/Posting.hs | 4 +- hledger-lib/Hledger/Data/Valuation.hs | 4 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 2 +- 5 files changed, 80 insertions(+), 34 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 05da2e52f..a4a382cae 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -73,8 +73,12 @@ module Hledger.Data.Amount ( oneLine, csvDisplay, amountstyle, + canonicaliseAmount, styleAmount, styleAmountExceptPrecision, + amountSetStyles, + amountSetMainStyle, + amountSetCostStyle, amountUnstyled, showAmountB, showAmount, @@ -91,7 +95,6 @@ module Hledger.Data.Amount ( setAmountDecimalPoint, withDecimalPoint, amountStripPrices, - canonicaliseAmount, -- * MixedAmount nullmixedamt, missingmixedamt, @@ -125,7 +128,9 @@ module Hledger.Data.Amount ( maIsNonZero, mixedAmountLooksZero, -- ** rendering + canonicaliseMixedAmount, styleMixedAmount, + mixedAmountSetStyles, mixedAmountUnstyled, showMixedAmount, showMixedAmountOneLine, @@ -140,7 +145,6 @@ module Hledger.Data.Amount ( wbUnpack, mixedAmountSetPrecision, mixedAmountSetFullPrecision, - canonicaliseMixedAmount, -- * misc. tests_Amount ) where @@ -418,33 +422,67 @@ 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 apply the style, except for precision, to the cost. +-- Also do the same for the cost amount if any, but leave its precision unchanged. styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -styleAmount styles a = styledAmount{aprice = stylePrice styles (aprice styledAmount)} - where - styledAmount = case M.lookup (acommodity a) styles of - Just s -> a{astyle=s} - Nothing -> a +styleAmount = amountSetStyles +{-# DEPRECATED styleAmount "please use amountSetStyles instead" #-} -stylePrice :: M.Map CommoditySymbol AmountStyle -> Maybe AmountPrice -> Maybe AmountPrice -stylePrice styles (Just (UnitPrice a)) = Just (UnitPrice $ styleAmountExceptPrecision styles a) -stylePrice styles (Just (TotalPrice a)) = Just (TotalPrice $ styleAmountExceptPrecision styles a) -stylePrice _ _ = Nothing - --- | Like styleAmount, but keep the number of decimal places unchanged. +-- | Like styleAmount, but leave the display precision unchanged. styleAmountExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount styleAmountExceptPrecision styles a@Amount{astyle=AmountStyle{asprecision=origp}} = case M.lookup (acommodity a) styles of Just s -> a{astyle=s{asprecision=origp}} Nothing -> a +-- v2.9 + +-- | 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 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 + +-- | Find and apply the appropriate display style, if any, to this amount. +-- The display precision is also set. +amountSetMainStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount +amountSetMainStyle styles a@Amount{acommodity=comm} = + case M.lookup comm styles of + Nothing -> a + Just s -> a{astyle=s} + +-- | Find and apply the appropriate display style, if any, to this amount's cost, if any. +-- The display precision is left unchanged. +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 $ styleAmountExceptPrecision styles a2} + Just (TotalPrice a2) -> a{aprice=Just $ TotalPrice $ styleAmountExceptPrecision 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 @@ -540,12 +578,6 @@ applyDigitGroupStyle (Just (DigitGroups c (g0:gs0))) l0 s0 = addseps (g0:|gs0) ( gs2 = fromMaybe (g1:|[]) $ nonEmpty gs1 l2 = l1 - toInteger g1 --- like journalCanonicaliseAmounts --- | Canonicalise an amount's display style using the provided commodity style map. -canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'} - where s' = M.findWithDefault s c styles - ------------------------------------------------------------------------------- -- MixedAmount @@ -807,15 +839,33 @@ mixedAmountCost (Mixed ma) = -- where a' = mixedAmountStripPrices a -- b' = mixedAmountStripPrices b +-- Mixed amount styling +-- v1 + +-- | Canonicalise a mixed amount's display styles using the provided commodity style map. +-- Cost amounts, if any, are not affected. +canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount +canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles) +{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetMainStyle (or mixedAmountSetStyles) instead" #-} + +-- v2 + -- | 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 styles = mapMixedAmountUnsafe (styleAmount styles) +styleMixedAmount = mixedAmountSetStyles +{-# DEPRECATED styleMixedAmount "please use mixedAmountSetStyles instead" #-} + +-- v2.9 + +mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount +mixedAmountSetStyles styles = mapMixedAmountUnsafe (amountSetStyles styles) -- | Reset each individual amount's display style to the default. mixedAmountUnstyled :: MixedAmount -> MixedAmount mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled + -- | 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. @@ -1008,10 +1058,6 @@ mixedAmountStripPrices (Mixed ma) = foldl' (\m a -> maAddAmount m a{aprice=Nothing}) (Mixed noPrices) withPrices where (noPrices, withPrices) = M.partition (isNothing . aprice) ma --- | Canonicalise a mixed amount's display styles using the provided commodity style map. -canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles) - ------------------------------------------------------------------------------- -- tests diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index 4a33a5511..95e311ded 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -101,12 +101,12 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs VirtualPosting -> (l, r) -- check for mixed signs, detecting nonzeros at display precision - canonicalise = maybe id canonicaliseMixedAmount commodity_styles_ + setstyles = maybe id mixedAmountSetStyles commodity_styles_ postingBalancingAmount p | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p | otherwise = mixedAmountCost $ pamount p signsOk ps = - case filter (not.mixedAmountLooksZero) $ map (canonicalise.postingBalancingAmount) ps of + case filter (not.mixedAmountLooksZero) $ map (setstyles.postingBalancingAmount) ps of nonzeros | length nonzeros >= 2 -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1 _ -> True @@ -114,7 +114,7 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs -- check for zero sum, at display precision (rsumcost, bvsumcost) = (foldMap postingBalancingAmount rps, foldMap postingBalancingAmount bvps) - (rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost) + (rsumdisplay, bvsumdisplay) = (setstyles rsumcost, setstyles bvsumcost) (rsumok, bvsumok) = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay) -- generate error messages, showing amounts with their original precision @@ -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' = styleMixedAmount styles . mixedAmountCost $ maNegate a + a' = mixedAmountSetStyles 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 diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 5f148ec25..11b236131 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -413,7 +413,7 @@ postingApplyAliases aliases p@Posting{paccount} = -- | Choose and apply a consistent display style to the posting -- amounts in each commodity (see journalCommodityStyles). postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting -postingApplyCommodityStyles styles p = p{pamount=styleMixedAmount styles $ pamount p +postingApplyCommodityStyles styles p = p{pamount=mixedAmountSetStyles styles $ pamount p ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} where fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} @@ -436,7 +436,7 @@ postingToCost _ NoConversionOp p = Just p postingToCost styles ToCost p -- If this is a conversion posting with a matched transaction price posting, ignore it | "_conversion-matched" `elem` map fst (ptags p) && noCost = Nothing - | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p + | otherwise = Just $ postingTransformAmount (mixedAmountSetStyles styles . mixedAmountCost) p where noCost = (not . any (isJust . aprice) . amountsRaw) $ pamount p diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 7af0116ee..7c20110fd 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 = styleAmount styles . amountCost +amountToCost styles ToCost = amountSetStyles 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. - styleAmount styles + amountSetStyles 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/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index e18d223d4..8af5387d4 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -623,7 +623,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 -> styleMixedAmount styles . mixedAmountCost + ToCost -> mixedAmountSetStyles styles . mixedAmountCost styles = journalCommodityStyles j err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"