mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 10:17:35 +03:00
lib!: use styleAmounts in more places; add rounding strategies
This commit is contained in:
Simon Michael
parent
94ab8b1ed7
commit
c13c13ab1f
@ -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
|
||||
|
||||
@ -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 ?
|
||||
|
||||
@ -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".
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user