;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