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

;lib: refactor amount cost functions

Browse Source 
Rename costOfAmount -> amountCost, costOfMixedAmount -> mixedAmountCost,
drop amountToCost, mixedAmountToCost.
This commit is contained in:
Simon Michael 2020-05-31 15:48:08 -07:00
parent 90b18080b2
commit 97f2235bca
7 changed files with 33 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -61,8 +61,7 @@ module Hledger.Data.Amount (
(@@),
amountWithCommodity,
-- ** arithmetic
costOfAmount,
amountToCost,
amountCost,
amountIsZero,
amountLooksZero,
divideAmount,
@ -103,8 +102,7 @@ module Hledger.Data.Amount (
normaliseMixedAmount,
mixedAmountStripPrices,
-- ** arithmetic
costOfMixedAmount,
mixedAmountToCost,
mixedAmountCost,
divideMixedAmount,
multiplyMixedAmount,
divideMixedAmountAndPrice,
@ -211,22 +209,21 @@ similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{aspre
amountWithCommodity :: CommoditySymbol -> Amount -> Amount
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
costOfAmount :: Amount -> Amount
costOfAmount a@Amount{aquantity=q, aprice=mp} =
-- - price amounts should be positive
-- (though this is currently not enforced)
amountCost :: Amount -> Amount
amountCost a@Amount{aquantity=q, aprice=mp} =
case mp of
Nothing -> a
Just (UnitPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * 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.
-- Has no effect on amounts without one.
-- 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 (TotalPrice pa)) = " @@ " ++ showAmountDebug pa
-- | Given a map of standard amount display styles, apply the appropriate one to this amount.
-- If there's no standard style for this amount's commodity, return the amount unchanged.
-- | 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.
styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount styles a =
case M.lookup (acommodity a) styles of
@ -576,14 +574,10 @@ filterMixedAmountByCommodity c (Mixed as) = Mixed as'
mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount f (Mixed as) = Mixed $ map f as
-- | Convert a mixed amount's component amounts to the commodity of their
-- assigned price, if any.
costOfMixedAmount :: MixedAmount -> MixedAmount
costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount 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
-- | Convert all component amounts to cost/selling price where
-- possible (see amountCost).
mixedAmountCost :: MixedAmount -> MixedAmount
mixedAmountCost (Mixed as) = Mixed $ map amountCost as
-- | Divide a mixed amount's quantities by a constant.
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
@ -635,7 +629,8 @@ mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPrice
-- where a' = normaliseMixedAmountSquashPricesForDisplay a
-- 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 styles (Mixed as) = Mixed $ map (styleAmount styles) as
@ -742,11 +737,11 @@ mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnit
tests_Amount = tests "Amount" [
tests "Amount" [
test "costOfAmount" $ do
costOfAmount (eur 1) @?= eur 1
costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4
costOfAmount (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2
costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2)
test "amountCost" $ do
amountCost (eur 1) @?= eur 1
amountCost (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4
amountCost (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2
amountCost (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2)
,test "amountLooksZero" $ do
assertBool "" $ amountLooksZero amount

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

@ -331,7 +331,7 @@ postingApplyValuation priceoracle styles periodlast mreportlast today ismultiper
-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
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,
-- or the default valuation commodity, at the given valuation date,

6
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -357,7 +357,7 @@ transactionCheckBalanced mstyles t = errs
-- check for mixed signs, detecting nonzeros at display precision
canonicalise = maybe id canonicaliseMixedAmount mstyles
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
-> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1
_ -> True
@ -365,7 +365,7 @@ transactionCheckBalanced mstyles t = errs
-- check for zero sum, at display precision
(rsum, bvsum) = (sumPostings rps, sumPostings bvps)
(rsumcost, bvsumcost) = (costOfMixedAmount rsum, costOfMixedAmount bvsum)
(rsumcost, bvsumcost) = (mixedAmountCost rsum, mixedAmountCost bvsum)
(rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
(rsumok, bvsumok) = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)
@ -475,7 +475,7 @@ inferBalancingAmount 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 $ normaliseMixedAmount $ costOfMixedAmount (-a)
a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a)
-- | 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

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

@ -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 styles periodlast mreportlast today ismultiperiod v a =
case v of
AtCost Nothing -> amountToCost styles a
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ amountToCost styles a
AtCost Nothing -> styleAmount styles $ amountCost a
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a
AtThen _mc -> error' unsupportedValueThenError -- TODO
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a

2
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -885,7 +885,7 @@ getAmount rules record currency p1IsVirtual n =
, let a = parseAmount rules record currency v
-- With amount/amount-in/amount-out, in posting 2,
-- 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

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

@ -296,7 +296,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
_ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage
Nothing
where
maybecost = if valuationTypeIsCost ropts then costOfMixedAmount else id
maybecost = if valuationTypeIsCost ropts then mixedAmountCost else id
showamt :: MixedAmount -> String
showamt | color_ = cshowMixedAmountOneLineWithoutPrice
| otherwise = showMixedAmountOneLineWithoutPrice

2
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -234,7 +234,7 @@ total trans query = unMix $ sumPostings $ filter (matchesPosting query) $ concat
unMix :: MixedAmount -> Quantity
unMix a =
case (normaliseMixedAmount $ costOfMixedAmount a) of
case (normaliseMixedAmount $ mixedAmountCost a) of
(Mixed [a]) -> aquantity a
_ -> error "MixedAmount failed to normalize"