;lib: refactor amount cost functions
Rename costOfAmount -> amountCost, costOfMixedAmount -> mixedAmountCost, drop amountToCost, mixedAmountToCost.
This commit is contained in:
parent
90b18080b2
commit
97f2235bca
@ -61,8 +61,7 @@ module Hledger.Data.Amount (
|
|||||||
(@@),
|
(@@),
|
||||||
amountWithCommodity,
|
amountWithCommodity,
|
||||||
-- ** arithmetic
|
-- ** arithmetic
|
||||||
costOfAmount,
|
amountCost,
|
||||||
amountToCost,
|
|
||||||
amountIsZero,
|
amountIsZero,
|
||||||
amountLooksZero,
|
amountLooksZero,
|
||||||
divideAmount,
|
divideAmount,
|
||||||
@ -103,8 +102,7 @@ module Hledger.Data.Amount (
|
|||||||
normaliseMixedAmount,
|
normaliseMixedAmount,
|
||||||
mixedAmountStripPrices,
|
mixedAmountStripPrices,
|
||||||
-- ** arithmetic
|
-- ** arithmetic
|
||||||
costOfMixedAmount,
|
mixedAmountCost,
|
||||||
mixedAmountToCost,
|
|
||||||
divideMixedAmount,
|
divideMixedAmount,
|
||||||
multiplyMixedAmount,
|
multiplyMixedAmount,
|
||||||
divideMixedAmountAndPrice,
|
divideMixedAmountAndPrice,
|
||||||
@ -211,22 +209,21 @@ similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{aspre
|
|||||||
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
|
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
|
||||||
amountWithCommodity c a = a{acommodity=c, aprice=Nothing}
|
amountWithCommodity c a = a{acommodity=c, aprice=Nothing}
|
||||||
|
|
||||||
-- | Convert an amount to the commodity of its assigned price, if any. Notes:
|
-- | Convert a amount to its "cost" or "selling price" in another commodity,
|
||||||
|
-- using its attached transaction price if it has one. Notes:
|
||||||
--
|
--
|
||||||
-- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error) XXX
|
-- - price amounts must be MixedAmounts with exactly one component Amount
|
||||||
|
-- (or there will be a runtime error XXX)
|
||||||
--
|
--
|
||||||
-- - price amounts should be positive, though this is not currently enforced
|
-- - price amounts should be positive
|
||||||
costOfAmount :: Amount -> Amount
|
-- (though this is currently not enforced)
|
||||||
costOfAmount a@Amount{aquantity=q, aprice=mp} =
|
amountCost :: Amount -> Amount
|
||||||
|
amountCost a@Amount{aquantity=q, aprice=mp} =
|
||||||
case mp of
|
case mp of
|
||||||
Nothing -> a
|
Nothing -> a
|
||||||
Just (UnitPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * q}
|
Just (UnitPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * q}
|
||||||
Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * signum q}
|
Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * signum q}
|
||||||
|
|
||||||
-- | Convert this amount to cost, and apply the appropriate amount style.
|
|
||||||
amountToCost :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
|
|
||||||
amountToCost styles = styleAmount styles . costOfAmount
|
|
||||||
|
|
||||||
-- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
|
-- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
|
||||||
-- Has no effect on amounts without one.
|
-- Has no effect on amounts without one.
|
||||||
-- Also increases the unit price's display precision to show one extra decimal place,
|
-- Also increases the unit price's display precision to show one extra decimal place,
|
||||||
@ -370,8 +367,9 @@ showAmountPriceDebug Nothing = ""
|
|||||||
showAmountPriceDebug (Just (UnitPrice pa)) = " @ " ++ showAmountDebug pa
|
showAmountPriceDebug (Just (UnitPrice pa)) = " @ " ++ showAmountDebug pa
|
||||||
showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa
|
showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa
|
||||||
|
|
||||||
-- | Given a map of standard amount display styles, apply the appropriate one to this amount.
|
-- | Given a map of standard commodity display styles, apply the
|
||||||
-- If there's no standard style for this amount's commodity, return the amount unchanged.
|
-- 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 :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
|
||||||
styleAmount styles a =
|
styleAmount styles a =
|
||||||
case M.lookup (acommodity a) styles of
|
case M.lookup (acommodity a) styles of
|
||||||
@ -576,14 +574,10 @@ filterMixedAmountByCommodity c (Mixed as) = Mixed as'
|
|||||||
mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount
|
mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount
|
||||||
mapMixedAmount f (Mixed as) = Mixed $ map f as
|
mapMixedAmount f (Mixed as) = Mixed $ map f as
|
||||||
|
|
||||||
-- | Convert a mixed amount's component amounts to the commodity of their
|
-- | Convert all component amounts to cost/selling price where
|
||||||
-- assigned price, if any.
|
-- possible (see amountCost).
|
||||||
costOfMixedAmount :: MixedAmount -> MixedAmount
|
mixedAmountCost :: MixedAmount -> MixedAmount
|
||||||
costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as
|
mixedAmountCost (Mixed as) = Mixed $ map amountCost as
|
||||||
|
|
||||||
-- | Convert all component amounts to cost, and apply the appropriate amount styles.
|
|
||||||
mixedAmountToCost :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
|
||||||
mixedAmountToCost styles (Mixed as) = Mixed $ map (amountToCost styles) as
|
|
||||||
|
|
||||||
-- | Divide a mixed amount's quantities by a constant.
|
-- | Divide a mixed amount's quantities by a constant.
|
||||||
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
|
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
|
||||||
@ -635,7 +629,8 @@ mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPrice
|
|||||||
-- where a' = normaliseMixedAmountSquashPricesForDisplay a
|
-- where a' = normaliseMixedAmountSquashPricesForDisplay a
|
||||||
-- b' = normaliseMixedAmountSquashPricesForDisplay b
|
-- b' = normaliseMixedAmountSquashPricesForDisplay b
|
||||||
|
|
||||||
-- | Given a map of standard amount display styles, apply the appropriate ones to each individual amount.
|
-- | Given a map of standard commodity display styles, apply the
|
||||||
|
-- appropriate one to each individual amount.
|
||||||
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
||||||
styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as
|
styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as
|
||||||
|
|
||||||
@ -742,11 +737,11 @@ mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnit
|
|||||||
tests_Amount = tests "Amount" [
|
tests_Amount = tests "Amount" [
|
||||||
tests "Amount" [
|
tests "Amount" [
|
||||||
|
|
||||||
test "costOfAmount" $ do
|
test "amountCost" $ do
|
||||||
costOfAmount (eur 1) @?= eur 1
|
amountCost (eur 1) @?= eur 1
|
||||||
costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4
|
amountCost (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4
|
||||||
costOfAmount (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2
|
amountCost (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2
|
||||||
costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2)
|
amountCost (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2)
|
||||||
|
|
||||||
,test "amountLooksZero" $ do
|
,test "amountLooksZero" $ do
|
||||||
assertBool "" $ amountLooksZero amount
|
assertBool "" $ amountLooksZero amount
|
||||||
|
|||||||
@ -331,7 +331,7 @@ postingApplyValuation priceoracle styles periodlast mreportlast today ismultiper
|
|||||||
|
|
||||||
-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
|
-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
|
||||||
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
|
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
|
||||||
postingToCost styles p@Posting{pamount=a} = p{pamount=mixedAmountToCost styles a}
|
postingToCost styles p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a}
|
||||||
|
|
||||||
-- | Convert this posting's amount to market value in the given commodity,
|
-- | Convert this posting's amount to market value in the given commodity,
|
||||||
-- or the default valuation commodity, at the given valuation date,
|
-- or the default valuation commodity, at the given valuation date,
|
||||||
|
|||||||
@ -357,7 +357,7 @@ transactionCheckBalanced mstyles t = errs
|
|||||||
-- check for mixed signs, detecting nonzeros at display precision
|
-- check for mixed signs, detecting nonzeros at display precision
|
||||||
canonicalise = maybe id canonicaliseMixedAmount mstyles
|
canonicalise = maybe id canonicaliseMixedAmount mstyles
|
||||||
signsOk ps =
|
signsOk ps =
|
||||||
case filter (not.mixedAmountLooksZero) $ map (canonicalise.costOfMixedAmount.pamount) ps of
|
case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of
|
||||||
nonzeros | length nonzeros >= 2
|
nonzeros | length nonzeros >= 2
|
||||||
-> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1
|
-> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1
|
||||||
_ -> True
|
_ -> True
|
||||||
@ -365,7 +365,7 @@ transactionCheckBalanced mstyles t = errs
|
|||||||
|
|
||||||
-- check for zero sum, at display precision
|
-- check for zero sum, at display precision
|
||||||
(rsum, bvsum) = (sumPostings rps, sumPostings bvps)
|
(rsum, bvsum) = (sumPostings rps, sumPostings bvps)
|
||||||
(rsumcost, bvsumcost) = (costOfMixedAmount rsum, costOfMixedAmount bvsum)
|
(rsumcost, bvsumcost) = (mixedAmountCost rsum, mixedAmountCost bvsum)
|
||||||
(rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
|
(rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
|
||||||
(rsumok, bvsumok) = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)
|
(rsumok, bvsumok) = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)
|
||||||
|
|
||||||
@ -475,7 +475,7 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
|
|||||||
-- Inferred amounts are converted to cost.
|
-- Inferred amounts are converted to cost.
|
||||||
-- Also ensure the new amount has the standard style for its commodity
|
-- Also ensure the new amount has the standard style for its commodity
|
||||||
-- (since the main amount styling pass happened before this balancing pass);
|
-- (since the main amount styling pass happened before this balancing pass);
|
||||||
a' = styleMixedAmount styles $ normaliseMixedAmount $ costOfMixedAmount (-a)
|
a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a)
|
||||||
|
|
||||||
-- | Infer prices for this transaction's posting amounts, if needed to make
|
-- | 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
|
-- the postings balance, and if possible. This is done once for the real
|
||||||
|
|||||||
@ -141,8 +141,8 @@ mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismult
|
|||||||
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount
|
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount
|
||||||
amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v a =
|
amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v a =
|
||||||
case v of
|
case v of
|
||||||
AtCost Nothing -> amountToCost styles a
|
AtCost Nothing -> styleAmount styles $ amountCost a
|
||||||
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ amountToCost styles a
|
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a
|
||||||
AtThen _mc -> error' unsupportedValueThenError -- TODO
|
AtThen _mc -> error' unsupportedValueThenError -- TODO
|
||||||
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
|
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
|
||||||
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
|
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
|
||||||
|
|||||||
@ -885,7 +885,7 @@ getAmount rules record currency p1IsVirtual n =
|
|||||||
, let a = parseAmount rules record currency v
|
, let a = parseAmount rules record currency v
|
||||||
-- With amount/amount-in/amount-out, in posting 2,
|
-- With amount/amount-in/amount-out, in posting 2,
|
||||||
-- flip the sign and convert to cost, as they did before 1.17
|
-- flip the sign and convert to cost, as they did before 1.17
|
||||||
, let a' = if f `elem` unnumberedfieldnames && n==2 then costOfMixedAmount (-a) else a
|
, let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (-a) else a
|
||||||
]
|
]
|
||||||
|
|
||||||
-- if any of the numbered field names are present, discard all the unnumbered ones
|
-- if any of the numbered field names are present, discard all the unnumbered ones
|
||||||
|
|||||||
@ -296,7 +296,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
|||||||
_ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage
|
_ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage
|
||||||
Nothing
|
Nothing
|
||||||
where
|
where
|
||||||
maybecost = if valuationTypeIsCost ropts then costOfMixedAmount else id
|
maybecost = if valuationTypeIsCost ropts then mixedAmountCost else id
|
||||||
showamt :: MixedAmount -> String
|
showamt :: MixedAmount -> String
|
||||||
showamt | color_ = cshowMixedAmountOneLineWithoutPrice
|
showamt | color_ = cshowMixedAmountOneLineWithoutPrice
|
||||||
| otherwise = showMixedAmountOneLineWithoutPrice
|
| otherwise = showMixedAmountOneLineWithoutPrice
|
||||||
|
|||||||
@ -234,7 +234,7 @@ total trans query = unMix $ sumPostings $ filter (matchesPosting query) $ concat
|
|||||||
|
|
||||||
unMix :: MixedAmount -> Quantity
|
unMix :: MixedAmount -> Quantity
|
||||||
unMix a =
|
unMix a =
|
||||||
case (normaliseMixedAmount $ costOfMixedAmount a) of
|
case (normaliseMixedAmount $ mixedAmountCost a) of
|
||||||
(Mixed [a]) -> aquantity a
|
(Mixed [a]) -> aquantity a
|
||||||
_ -> error "MixedAmount failed to normalize"
|
_ -> error "MixedAmount failed to normalize"
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user