slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

dev: consolidate amount styling as a new (interim) api

Browse Source
This commit is contained in:
Simon Michael 2023-08-28 07:26:16 +01:00
parent 9b15d34f9c
commit 9f0840456d
5 changed files with 80 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
hledger-lib/Hledger/Data/Amount.hs
View File

@ -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

8
hledger-lib/Hledger/Data/Balancing.hs
View File

@ -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

4
hledger-lib/Hledger/Data/Posting.hs
View File

@ -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

4
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -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

2
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -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"