From 8102bd9c2b46a0fb4bd11a1035bc889e85bea732 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 23 Jan 2024 07:38:59 -1000 Subject: [PATCH] dev: AmountPrice,UnitPrice,TotalPrice -> AmountCost,UnitCost,TotalCost; related renames --- hledger-lib/Hledger/Data/Amount.hs | 147 +++++++++--------- hledger-lib/Hledger/Data/Balancing.hs | 8 +- hledger-lib/Hledger/Data/Journal.hs | 6 +- hledger-lib/Hledger/Data/Json.hs | 4 +- hledger-lib/Hledger/Data/Posting.hs | 4 +- hledger-lib/Hledger/Data/Transaction.hs | 2 +- .../Hledger/Data/TransactionModifier.hs | 2 +- hledger-lib/Hledger/Data/Types.hs | 50 +++--- hledger-lib/Hledger/Data/Valuation.hs | 4 +- hledger-lib/Hledger/Read/Common.hs | 14 +- hledger/Hledger/Cli/Commands/Roi.hs | 30 ++-- 11 files changed, 135 insertions(+), 136 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index cbcf2fe07..5c93bfb45 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -12,13 +12,13 @@ It has a (possibly null) 'CommoditySymbol' and a numeric quantity: 0 @ -It may also have an assigned 'Price', representing this amount's per-unit +It may also have an 'AmountCost', representing this amount's per-unit or total cost in a different commodity. If present, this is rendered like so: @ - EUR 2 \@ $1.50 (unit price) - EUR 2 \@\@ $3 (total price) + EUR 2 \@ $1.50 (unit cost) + EUR 2 \@\@ $3 (total cost) @ A 'MixedAmount' is zero or more simple amounts, so can represent multiple @@ -31,12 +31,11 @@ commodities; this is the type most often used: @ A mixed amount is always \"normalised\", it has no more than one amount -in each commodity and price. When calling 'amounts' it will have no zero +in each commodity and cost. When calling 'amounts' it will have no zero amounts, or just a single zero amount and no other amounts. Limited arithmetic with simple and mixed amounts is supported, best used -with similar amounts since it mostly ignores assigned prices and commodity -exchange rates. +with similar amounts since it mostly ignores costss and commodity exchange rates. -} @@ -253,11 +252,11 @@ noColour = AmountDisplayOpts { , displayColour = False } --- | Display Amount and MixedAmount with no prices. +-- | Display Amount and MixedAmount with no costs. noCost :: AmountDisplayOpts noCost = def{displayCost=False} --- | Display Amount and MixedAmount on one line with no prices. +-- | Display Amount and MixedAmount on one line with no costs. oneLine :: AmountDisplayOpts oneLine = def{displayOneLine=True, displayCost=False} @@ -297,15 +296,15 @@ usd n = nullamt{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprec eur n = nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} gbp n = nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} per n = nullamt{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}} -amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} -amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} +amt `at` costamt = amt{aprice=Just $ UnitCost costamt} +amt @@ costamt = amt{aprice=Just $ TotalCost costamt} -- | Apply a binary arithmetic operator to two amounts, which should -- be in the same commodity if non-zero (warning, this is not checked). -- A zero result keeps the commodity of the second amount. -- The result's display style is that of the second amount, with -- precision set to the highest of either amount. --- Prices are ignored and discarded. +-- Costs are ignored and discarded. -- Remember: the caller is responsible for ensuring both amounts have the same commodity. similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}} @@ -316,41 +315,41 @@ similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{aspre -- otherwise = error "tried to do simple arithmetic with amounts in different commodities" -- | Convert an amount to the specified commodity, ignoring and discarding --- any assigned prices and assuming an exchange rate of 1. +-- any costs and assuming an exchange rate of 1. amountWithCommodity :: CommoditySymbol -> Amount -> Amount amountWithCommodity c a = a{acommodity=c, aprice=Nothing} -- | Convert a amount to its "cost" or "selling price" in another commodity, --- using its attached transaction price if it has one. Notes: +-- using its attached cost if it has one. Notes: -- --- - price amounts must be MixedAmounts with exactly one component Amount +-- - cost amounts must be MixedAmounts with exactly one component Amount -- (or there will be a runtime error XXX) -- --- - price amounts should be positive in the Journal +-- - cost amounts should be positive in the Journal -- (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} + Just (UnitCost p@Amount{aquantity=pq}) -> p{aquantity=pq * q} + Just (TotalCost p@Amount{aquantity=pq}) -> p{aquantity=pq} --- | Strip all prices from an Amount +-- | Strip all costs from an Amount amountStripCost :: Amount -> Amount amountStripCost a = a{aprice=Nothing} --- | Apply a function to an amount's quantity (and its total price, if it has one). +-- | Apply a function to an amount's quantity (and its total cost, if it has one). transformAmount :: (Quantity -> Quantity) -> Amount -> Amount transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p} where - f' (TotalPrice a1@Amount{aquantity=pq}) = TotalPrice a1{aquantity = f pq} + f' (TotalCost a1@Amount{aquantity=pq}) = TotalCost a1{aquantity = f pq} f' p' = p' -- | Divide an amount's quantity (and total cost, if any) by some number. divideAmount :: Quantity -> Amount -> Amount divideAmount n = transformAmount (/n) --- | Multiply an amount's quantity (and its total price, if it has one) by a constant. +-- | Multiply an amount's quantity (and its total cost, if it has one) by a constant. multiplyAmount :: Quantity -> Amount -> Amount multiplyAmount n = transformAmount (*n) @@ -359,7 +358,7 @@ multiplyAmount n = transformAmount (*n) invertAmount :: Amount -> Amount invertAmount a@Amount{aquantity=q} = a{aquantity=1/q} --- | Is this amount negative ? The price is ignored. +-- | Is this amount negative ? The cost is ignored. isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{aquantity=q} = q < 0 @@ -370,26 +369,26 @@ amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=mp}} = NaturalPrecision -> q Precision p -> roundTo p q --- | Apply a test to both an Amount and its total price, if it has one. -testAmountAndTotalPrice :: (Amount -> Bool) -> Amount -> Bool -testAmountAndTotalPrice f amt = case aprice amt of - Just (TotalPrice price) -> f amt && f price +-- | Apply a test to both an Amount and its total cost, if it has one. +testAmountAndTotalCost :: (Amount -> Bool) -> Amount -> Bool +testAmountAndTotalCost f amt = case aprice amt of + Just (TotalCost cost) -> f amt && f cost _ -> f amt --- | Do this Amount and (and its total price, if it has one) appear to be zero +-- | Do this Amount and (and its total cost, if it has one) appear to be zero -- when rendered with its display precision ? -- The display precision should usually have a specific value here; -- if unset, it will be treated like NaturalPrecision. amountLooksZero :: Amount -> Bool -amountLooksZero = testAmountAndTotalPrice looksZero +amountLooksZero = testAmountAndTotalCost looksZero where looksZero Amount{aquantity=Decimal e q, astyle=AmountStyle{asprecision=p}} = case p of Precision d -> if e > d then abs q <= 5*10^(e-d-1) else q == 0 NaturalPrecision -> q == 0 --- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? +-- | Is this Amount (and its total cost, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool -amountIsZero = testAmountAndTotalPrice (\Amount{aquantity=Decimal _ q} -> q == 0) +amountIsZero = testAmountAndTotalCost (\Amount{aquantity=Decimal _ q} -> q == 0) -- | Does this amount's internal Decimal representation have the -- maximum number of digits, suggesting that it probably is @@ -522,8 +521,8 @@ instance HasAmounts Amount where 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} + Just (UnitCost ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ UnitCost ca{astyle=mknewstyle True cq cs ccomm} + Just (TotalCost ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ TotalCost ca{astyle=mknewstyle True cq cs ccomm} mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle mknewstyle iscost oldq olds com = @@ -620,14 +619,14 @@ withDecimalPoint = flip setAmountDecimalPoint showAmountCostB :: Amount -> WideBuilder showAmountCostB amt = case aprice amt of Nothing -> mempty - Just (UnitPrice pa) -> WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour{displayZeroCommodity=True} pa - Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour{displayZeroCommodity=True} (sign pa) + Just (UnitCost pa) -> WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour{displayZeroCommodity=True} pa + Just (TotalCost pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour{displayZeroCommodity=True} (sign pa) where sign = if aquantity amt < 0 then negate else id -showAmountCostDebug :: Maybe AmountPrice -> String +showAmountCostDebug :: Maybe AmountCost -> String showAmountCostDebug Nothing = "" -showAmountCostDebug (Just (UnitPrice pa)) = " @ " ++ showAmountDebug pa -showAmountCostDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa +showAmountCostDebug (Just (UnitCost pa)) = " @ " ++ showAmountDebug pa +showAmountCostDebug (Just (TotalCost pa)) = " @@ " ++ showAmountDebug pa -- | Get the string representation of an amount, based on its -- commodity's display settings. String representations equivalent to @@ -657,8 +656,8 @@ showAmountB ,displayForceDecimalMark, displayCost, displayColour} a@Amount{astyle=style} = color $ case ascommodityside style of - L -> (if displayCommodity then wbFromText comm <> space else mempty) <> quantity' <> price - R -> quantity' <> (if displayCommodity then space <> wbFromText comm else mempty) <> price + L -> (if displayCommodity then wbFromText comm <> space else mempty) <> quantity' <> cost + R -> quantity' <> (if displayCommodity then space <> wbFromText comm else mempty) <> cost where color = if displayColour && isNegativeAmount a then colorB Dull Red else id quantity = showAmountQuantity displayForceDecimalMark $ @@ -667,7 +666,7 @@ showAmountB | amountLooksZero a && not displayZeroCommodity = (WideBuilder (TB.singleton '0') 1, "") | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) space = if not (T.null comm) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty - price = if displayCost then showAmountCostB a else mempty + cost = if displayCost then showAmountCostB a else mempty -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red. @@ -676,7 +675,7 @@ showAmountB cshowAmount :: Amount -> String cshowAmount = wbUnpack . showAmountB def{displayColour=True} --- | Get the string representation of an amount, without any \@ price. +-- | Get the string representation of an amount, without any \@ cost. -- -- > showAmountWithoutPrice = wbUnpack . showAmountB noCost showAmountWithoutPrice :: Amount -> String @@ -760,9 +759,9 @@ instance Num MixedAmount where -- | Calculate the key used to store an Amount within a MixedAmount. amountKey :: Amount -> MixedAmountKey amountKey amt@Amount{acommodity=c} = case aprice amt of - Nothing -> MixedAmountKeyNoPrice c - Just (TotalPrice p) -> MixedAmountKeyTotalPrice c (acommodity p) - Just (UnitPrice p) -> MixedAmountKeyUnitPrice c (acommodity p) (aquantity p) + Nothing -> MixedAmountKeyNoCost c + Just (TotalCost p) -> MixedAmountKeyTotalCost c (acommodity p) + Just (UnitCost p) -> MixedAmountKeyUnitCost c (acommodity p) (aquantity p) -- | The empty mixed amount. nullmixedamt :: MixedAmount @@ -798,7 +797,7 @@ maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstPrice maAddAmounts :: Foldable t => MixedAmount -> t Amount -> MixedAmount maAddAmounts = foldl' maAddAmount --- | Negate mixed amount's quantities (and total prices, if any). +-- | Negate mixed amount's quantities (and total costs, if any). maNegate :: MixedAmount -> MixedAmount maNegate = transformMixedAmount negate @@ -817,15 +816,15 @@ maMinus a = maPlus a . maNegate maSum :: Foldable t => t MixedAmount -> MixedAmount maSum = foldl' maPlus nullmixedamt --- | Divide a mixed amount's quantities (and total prices, if any) by a constant. +-- | Divide a mixed amount's quantities (and total costs, if any) by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount divideMixedAmount n = transformMixedAmount (/n) --- | Multiply a mixed amount's quantities (and total prices, if any) by a constant. +-- | Multiply a mixed amount's quantities (and total costs, if any) by a constant. multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount multiplyMixedAmount n = transformMixedAmount (*n) --- | Apply a function to a mixed amount's quantities (and its total prices, if it has any). +-- | Apply a function to a mixed amount's quantities (and its total costs, if it has any). transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount transformMixedAmount f = mapMixedAmountUnsafe (transformAmount f) @@ -869,7 +868,7 @@ maIsNonZero = not . mixedAmountIsZero -- | Get a mixed amount's component amounts, with some cleanups. -- The following descriptions are old and possibly wrong: -- --- * amounts in the same commodity are combined unless they have different prices or total prices +-- * amounts in the same commodity are combined unless they have different costs or total costs -- -- * multiple zero amounts, all with the same non-null commodity, are replaced by just the last of them, preserving the commodity and amount style (all but the last zero amount are discarded) -- @@ -915,8 +914,8 @@ amountsPreservingZeros (Mixed ma) -- | Get a mixed amount's component amounts without normalising zero and missing -- amounts. This is used for JSON serialisation, so the order is important. In -- particular, we want the Amounts given in the order of the MixedAmountKeys, --- i.e. lexicographically first by commodity, then by price commodity, then by --- unit price from most negative to most positive. +-- i.e. lexicographically first by commodity, then by cost commodity, then by +-- unit cost from most negative to most positive. amountsRaw :: MixedAmount -> [Amount] amountsRaw (Mixed ma) = toList ma @@ -940,18 +939,18 @@ unifyMixedAmount = foldM combine 0 . amounts | otherwise = Nothing -- | Sum same-commodity amounts in a lossy way, applying the first --- price to the result and discarding any other prices. Only used as a +-- cost to the result and discarding any other costs. Only used as a -- rendering helper. sumSimilarAmountsUsingFirstPrice :: Amount -> Amount -> Amount sumSimilarAmountsUsingFirstPrice a b = (a + b){aprice=p} where p = case (aprice a, aprice b) of - (Just (TotalPrice ap), Just (TotalPrice bp)) - -> Just . TotalPrice $ ap{aquantity = aquantity ap + aquantity bp } + (Just (TotalCost ap), Just (TotalCost bp)) + -> Just . TotalCost $ ap{aquantity = aquantity ap + aquantity bp } _ -> aprice a --- -- | Sum same-commodity amounts. If there were different prices, set --- -- the price to a special marker indicating "various". Only used as a +-- -- | Sum same-commodity amounts. If there were different costs, set +-- -- the cost to a special marker indicating "various". Only used as a -- -- rendering helper. -- sumSimilarAmountsNotingPriceDifference :: [Amount] -> Amount -- sumSimilarAmountsNotingPriceDifference [] = nullamt @@ -976,8 +975,8 @@ mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount mapMixedAmount f (Mixed ma) = mixed . map f $ toList ma -- | Apply a transform to a mixed amount's component 'Amount's, which does not --- affect the key of the amount (i.e. doesn't change the commodity, price --- commodity, or unit price amount). This condition is not checked. +-- affect the key of the amount (i.e. doesn't change the commodity, cost +-- commodity, or unit cost amount). This condition is not checked. mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma -- Use M.map instead of fmap to maintain strictness @@ -985,8 +984,8 @@ mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma -- Use M.map instead of -- possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount mixedAmountCost (Mixed ma) = - foldl' (\m a -> maAddAmount m (amountCost a)) (Mixed noPrices) withPrices - where (noPrices, withPrices) = M.partition (isNothing . aprice) ma + foldl' (\m a -> maAddAmount m (amountCost a)) (Mixed noCosts) withCosts + where (noCosts, withCosts) = M.partition (isNothing . aprice) ma -- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there. @@ -1031,7 +1030,7 @@ 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. +-- no or similar costs, otherwise this can show misleading costs. -- -- > showMixedAmount = wbUnpack . showMixedAmountB noColour showMixedAmount :: MixedAmount -> String @@ -1050,7 +1049,7 @@ showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine{displayCost=True} showMixedAmountWithZeroCommodity :: MixedAmount -> String showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True} --- | Get the string representation of a mixed amount, without showing any transaction prices. +-- | Get the string representation of a mixed amount, without showing any costs. -- With a True argument, adds ANSI codes to show negative amounts in red. -- -- > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noCost{displayColour=c} @@ -1058,7 +1057,7 @@ showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noCost{displayColour=c} -- | Get the one-line string representation of a mixed amount, but without --- any \@ prices. +-- any \@ costs. -- With a True argument, adds ANSI codes to show negative amounts in red. -- -- > showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c} @@ -1225,7 +1224,7 @@ mixedAmountSetPrecisionMin p = mapMixedAmountUnsafe (amountSetPrecisionMin p) mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount mixedAmountSetPrecisionMax p = mapMixedAmountUnsafe (amountSetPrecisionMax p) --- | Remove all prices from a MixedAmount. +-- | Remove all costs from a MixedAmount. mixedAmountStripPrices :: MixedAmount -> MixedAmount mixedAmountStripPrices (Mixed ma) = foldl' (\m a -> maAddAmount m a{aprice=Nothing}) (Mixed noPrices) withPrices @@ -1240,9 +1239,9 @@ tests_Amount = testGroup "Amount" [ testCase "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) + amountCost (eur 2){aprice=Just $ UnitCost $ usd 2} @?= usd 4 + amountCost (eur 1){aprice=Just $ TotalCost $ usd 2} @?= usd 2 + amountCost (eur (-1)){aprice=Just $ TotalCost $ usd (-2)} @?= usd (-2) ,testCase "amountLooksZero" $ do assertBool "" $ amountLooksZero nullamt @@ -1250,9 +1249,9 @@ tests_Amount = testGroup "Amount" [ ,testCase "negating amounts" $ do negate (usd 1) @?= (usd 1){aquantity= -1} - let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1} + let b = (usd 1){aprice=Just $ UnitCost $ eur 2} in negate b @?= b{aquantity= -1} - ,testCase "adding amounts without prices" $ do + ,testCase "adding amounts without costs" $ do (usd 1.23 + usd (-1.23)) @?= usd 0 (usd 1.23 + usd (-1.23)) @?= usd 0 (usd (-1.23) + usd (-1.23)) @?= usd (-2.46) @@ -1285,7 +1284,7 @@ tests_Amount = testGroup "Amount" [ ]) @?= mixedAmount (usd 0 `withPrecision` Precision 3) - ,testCase "adding mixed amounts with total prices" $ do + ,testCase "adding mixed amounts with total costs" $ do maSum (map mixedAmount [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 @@ -1307,13 +1306,13 @@ tests_Amount = testGroup "Amount" [ ,testGroup "amounts" [ testCase "a missing amount overrides any other amounts" $ amounts (mixed [usd 1, missingamt]) @?= [missingamt] - ,testCase "unpriced same-commodity amounts are combined" $ + ,testCase "costless same-commodity amounts are combined" $ amounts (mixed [usd 0, usd 2]) @?= [usd 2] - ,testCase "amounts with same unit price are combined" $ + ,testCase "amounts with same unit cost are combined" $ amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1] - ,testCase "amounts with different unit prices are not combined" $ + ,testCase "amounts with different unit costs are not combined" $ amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2] - ,testCase "amounts with total prices are combined" $ + ,testCase "amounts with total costs are combined" $ amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2] ] diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index db3a6b829..a08c7b403 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -357,13 +357,13 @@ costInferrerFor t pt = maybe id infercost inferFromAndTo , poriginal = Just $ originalPosting p } | otherwise = p where - -- If only one Amount in the posting list matches fromamount we can use TotalPrice. + -- If only one Amount in the posting list matches fromamount we can use TotalCost. -- Otherwise divide the conversion equally among the Amounts by using a unit price. conversionprice = case filter (== acommodity fromamount) pcommodities of - [_] -> TotalPrice $ negate toamount - _ -> UnitPrice $ negate unitprice `withPrecision` unitprecision + [_] -> TotalCost $ negate toamount + _ -> UnitCost $ negate unitcost `withPrecision` unitprecision - unitprice = aquantity fromamount `divideAmount` toamount + unitcost = aquantity fromamount `divideAmount` toamount unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b _ -> NaturalPrecision diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 3f34c10fc..e98cf2a7d 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -906,7 +906,7 @@ canonicalStyle a b = a{asprecision=prec, asdecimalmark=decmark, asdigitgroups=mg -- fixmixedamount = mapMixedAmount fixamount -- fixamount = fixprice -- fixprice a@Amount{price=Just _} = a --- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c} +-- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitCost) $ journalPriceDirectiveFor j d c} -- -- | Get the price for a commodity on the specified day from the price database, if known. -- -- Does only one lookup step, ie will not look up the price of a price. @@ -972,8 +972,8 @@ journalMarkRedundantCosts j = do -- amountCommodities :: Amount -> [CommoditySymbol] -- amountCommodities Amount{acommodity=c,aprice=p} = -- case p of Nothing -> [c] --- Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma) --- Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma) +-- Just (UnitCost ma) -> c:(concatMap amountCommodities $ amounts ma) +-- Just (TotalCost ma) -> c:(concatMap amountCommodities $ amounts ma) -- | Get an ordered list of amounts in this journal which can -- influence canonical amount display styles. Those amounts are, in diff --git a/hledger-lib/Hledger/Data/Json.hs b/hledger-lib/Hledger/Data/Json.hs index 2db1a4d2f..d5db788e1 100644 --- a/hledger-lib/Hledger/Data/Json.hs +++ b/hledger-lib/Hledger/Data/Json.hs @@ -102,7 +102,7 @@ instance ToJSON MixedAmount where toEncoding = toEncoding . amountsRaw instance ToJSON BalanceAssertion -instance ToJSON AmountPrice +instance ToJSON AmountCost instance ToJSON MarketPrice instance ToJSON PostingType @@ -208,7 +208,7 @@ instance FromJSON MixedAmount where parseJSON = fmap (mixed :: [Amount] -> MixedAmount) . parseJSON instance FromJSON BalanceAssertion -instance FromJSON AmountPrice +instance FromJSON AmountCost instance FromJSON MarketPrice instance FromJSON PostingType instance FromJSON Posting diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 4915801c7..11c3d932a 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -398,8 +398,8 @@ amountToBeancount a@Amount{acommodity=c,astyle=s,aprice=mp} = a{acommodity=c', a s' = s{ascommodityside=R, ascommodityspaced=True} mp' = costToBeancount <$> mp where - costToBeancount (TotalPrice amt) = TotalPrice $ amountToBeancount amt - costToBeancount (UnitPrice amt) = UnitPrice $ amountToBeancount amt + costToBeancount (TotalCost amt) = TotalCost $ amountToBeancount amt + costToBeancount (UnitCost amt) = UnitCost $ amountToBeancount amt -- | Like showAccountName for Beancount journal format. -- Calls accountNameToBeancount first. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index e05817e10..04d3dd2ac 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -400,7 +400,7 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount) addCostIfMatchesOneAmount a1 a2 p = do a <- postingSingleAmount p - let newp cost = p{pamount = mixedAmount a{aprice = Just $ TotalPrice cost}} + let newp cost = p{pamount = mixedAmount a{aprice = Just $ TotalCost cost}} if | amountsMatch (-a1) a -> Just (newp a2, a2) | amountsMatch (-a2) a -> Just (newp a1, a1) diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 0fd485719..cae368bf7 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -131,7 +131,7 @@ tmPostingRuleToFunction verbosetags styles query querytxt tmpr = matchedamount = dbg6 "matchedamount" . filterMixedAmount (symq `matchesAmount`) $ pamount p -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928). -- Approach 1: convert to a unit price and increase the display precision slightly - -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount + -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalCostToUnitCost matchedamount -- Approach 2: multiply the total price (keeping it positive) as well as the quantity as = dbg6 "multipliedamount" $ multiplyMixedAmount n matchedamount in diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index f4952a9a8..d897ea58e 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -171,7 +171,7 @@ data AccountType = | Revenue | Expense | Cash -- ^ a subtype of Asset - liquid assets to show in cashflow report - | Conversion -- ^ a subtype of Equity - account in which to generate conversion postings for transaction prices + | Conversion -- ^ a subtype of Equity - account with which to balance commodity conversions deriving (Eq,Ord,Generic) instance Show AccountType where @@ -246,7 +246,7 @@ deriving instance Generic (DecimalRaw a) -- | An amount's per-unit or total cost/selling price in another -- commodity, as recorded in the journal entry eg with @ or @@. -- "Cost", formerly AKA "transaction price". The amount is always positive. -data AmountPrice = UnitPrice !Amount | TotalPrice !Amount +data AmountCost = UnitCost !Amount | TotalCost !Amount deriving (Eq,Ord,Generic,Show) -- | Every Amount has one of these, influencing how the amount is displayed. @@ -312,7 +312,7 @@ data Amount = Amount { acommodity :: !CommoditySymbol, -- commodity symbol, or special value "AUTO" aquantity :: !Quantity, -- numeric quantity, or zero in case of "AUTO" astyle :: !AmountStyle, - aprice :: !(Maybe AmountPrice) -- ^ the (fixed, transaction-specific) price for this amount, if any + aprice :: !(Maybe AmountCost) -- ^ the (fixed, transaction-specific) cost in another commodity of this amount, if any } deriving (Eq,Ord,Generic,Show) -- | Types with this class have one or more amounts, @@ -350,41 +350,41 @@ maCompare (Mixed a) (Mixed b) = go (M.toList a) (M.toList b) go ((_,x):xs) [] = compareQuantities (Just x) Nothing <> go xs [] go [] ((_,y):ys) = compareQuantities Nothing (Just y) <> go [] ys go [] [] = EQ - compareQuantities = comparing (maybe 0 aquantity) <> comparing (maybe 0 totalprice) - totalprice x = case aprice x of - Just (TotalPrice p) -> aquantity p + compareQuantities = comparing (maybe 0 aquantity) <> comparing (maybe 0 totalcost) + totalcost x = case aprice x of + Just (TotalCost p) -> aquantity p _ -> 0 -- | Stores the CommoditySymbol of the Amount, along with the CommoditySymbol of --- the price, and its unit price if being used. +-- the cost, and its unit cost if being used. data MixedAmountKey - = MixedAmountKeyNoPrice !CommoditySymbol - | MixedAmountKeyTotalPrice !CommoditySymbol !CommoditySymbol - | MixedAmountKeyUnitPrice !CommoditySymbol !CommoditySymbol !Quantity + = MixedAmountKeyNoCost !CommoditySymbol + | MixedAmountKeyTotalCost !CommoditySymbol !CommoditySymbol + | MixedAmountKeyUnitCost !CommoditySymbol !CommoditySymbol !Quantity deriving (Eq,Generic,Show) -- | We don't auto-derive the Ord instance because it would give an undesired ordering. -- We want the keys to be sorted lexicographically: -- (1) By the primary commodity of the amount. --- (2) By the commodity of the price, with no price being first. --- (3) By the unit price, from most negative to most positive, with total prices --- before unit prices. +-- (2) By the commodity of the cost, with no cost being first. +-- (3) By the unit cost, from most negative to most positive, with total costs +-- before unit costs. -- For example, we would like the ordering to give --- MixedAmountKeyNoPrice "X" < MixedAmountKeyTotalPrice "X" "Z" < MixedAmountKeyNoPrice "Y" +-- MixedAmountKeyNoCost "X" < MixedAmountKeyTotalCost "X" "Z" < MixedAmountKeyNoCost "Y" instance Ord MixedAmountKey where - compare = comparing commodity <> comparing pCommodity <> comparing pPrice + compare = comparing commodity <> comparing pCommodity <> comparing pCost where - commodity (MixedAmountKeyNoPrice c) = c - commodity (MixedAmountKeyTotalPrice c _) = c - commodity (MixedAmountKeyUnitPrice c _ _) = c + commodity (MixedAmountKeyNoCost c) = c + commodity (MixedAmountKeyTotalCost c _) = c + commodity (MixedAmountKeyUnitCost c _ _) = c - pCommodity (MixedAmountKeyNoPrice _) = Nothing - pCommodity (MixedAmountKeyTotalPrice _ pc) = Just pc - pCommodity (MixedAmountKeyUnitPrice _ pc _) = Just pc + pCommodity (MixedAmountKeyNoCost _) = Nothing + pCommodity (MixedAmountKeyTotalCost _ pc) = Just pc + pCommodity (MixedAmountKeyUnitCost _ pc _) = Just pc - pPrice (MixedAmountKeyNoPrice _) = Nothing - pPrice (MixedAmountKeyTotalPrice _ _) = Nothing - pPrice (MixedAmountKeyUnitPrice _ _ q) = Just q + pCost (MixedAmountKeyNoCost _) = Nothing + pCost (MixedAmountKeyTotalCost _ _) = Nothing + pCost (MixedAmountKeyUnitCost _ _ q) = Just q data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting deriving (Eq,Show,Generic) @@ -439,7 +439,7 @@ data Posting = Posting { ptransaction :: Maybe Transaction, -- ^ this posting's parent transaction (co-recursive types). -- Tying this knot gets tedious, Maybe makes it easier/optional. poriginal :: Maybe Posting -- ^ When this posting has been transformed in some way - -- (eg its amount or price was inferred, or the account name was + -- (eg its amount or cost was inferred, or the account name was -- changed by a pivot or budget report), this references the original -- untransformed posting (which will have Nothing in this field). } deriving (Generic) diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 6016add54..c6d6f7d12 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -113,8 +113,8 @@ priceDirectiveToMarketPrice PriceDirective{..} = -- decimal digits; or if they seem to be infinite, defaultPrecisionLimit. amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=n} = case aprice amt of - Just (UnitPrice u) -> Just $ pd{pdamount=u} - Just (TotalPrice t) | n /= 0 -> Just $ pd{pdamount=u} + Just (UnitCost u) -> Just $ pd{pdamount=u} + Just (TotalCost t) | n /= 0 -> Just $ pd{pdamount=u} where u = amountSetFullPrecisionOr Nothing $ divideAmount n t _ -> Nothing where diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 728621f6a..0f1b858a8 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -909,14 +909,14 @@ simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) -- | Ledger-style cost notation: -- @ UNITAMT, @@ TOTALAMT, (@) UNITAMT, or (@@) TOTALAMT. The () are ignored. -costp :: Amount -> JournalParser m AmountPrice +costp :: Amount -> JournalParser m AmountCost costp baseAmt = -- dbg "costp" $ label "transaction price" $ do -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs parenthesised <- option False $ char '(' >> pure True char '@' - totalPrice <- char '@' $> True <|> pure False + totalCost <- char '@' $> True <|> pure False when parenthesised $ void $ char ')' lift skipNonNewlineSpaces @@ -925,9 +925,9 @@ costp baseAmt = let amtsign' = signum $ aquantity baseAmt amtsign = if amtsign' == 0 then 1 else amtsign' - pure $ if totalPrice - then TotalPrice priceAmount{aquantity=amtsign * aquantity priceAmount} - else UnitPrice priceAmount + pure $ if totalCost + then TotalCost priceAmount{aquantity=amtsign * aquantity priceAmount} + else UnitCost priceAmount -- | A valuation function or value can be written in double parentheses after an amount. valuationexprp :: JournalParser m () @@ -1586,7 +1586,7 @@ tests_Common = testGroup "Common" [ acommodity="$" ,aquantity=10 -- need to test internal precision with roundTo ? I think not ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing} - ,aprice=Just $ UnitPrice $ + ,aprice=Just $ UnitCost $ nullamt{ acommodity="€" ,aquantity=0.5 @@ -1598,7 +1598,7 @@ tests_Common = testGroup "Common" [ acommodity="$" ,aquantity=10 ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing} - ,aprice=Just $ TotalPrice $ + ,aprice=Just $ TotalCost $ nullamt{ acommodity="€" ,aquantity=5 diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index ef083a92a..fc71fe155 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -180,8 +180,8 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO timeWeightedReturn styles showCashFlow prettyTables investmentsQuery trans mixedAmountValue (OneSpan begin end valueBeforeAmt valueAfter cashFlow pnl) = do let valueBefore = unMix valueBeforeAmt - let initialUnitPrice = 100 :: Decimal - let initialUnits = valueBefore / initialUnitPrice + let initialUnitCost = 100 :: Decimal + let initialUnits = valueBefore / initialUnitCost let changes = -- If cash flow and PnL changes happen on the same day, this -- will sort PnL changes to come before cash flows (on any @@ -227,29 +227,29 @@ timeWeightedReturn styles showCashFlow prettyTables investmentsQuery trans mixed let units = tail $ scanl - (\(_, _, unitPrice, unitBalance) (date, amt) -> + (\(_, _, unitCost, unitBalance) (date, amt) -> let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just $ Exact date))]) in case amt of Right amt' -> -- we are buying or selling - let unitsBoughtOrSold = unMix amt' / unitPrice - in (valueOnDate, unitsBoughtOrSold, unitPrice, unitBalance + unitsBoughtOrSold) + let unitsBoughtOrSold = unMix amt' / unitCost + in (valueOnDate, unitsBoughtOrSold, unitCost, unitBalance + unitsBoughtOrSold) Left pnl' -> -- PnL change let valueAfterDate = valueOnDate + unMix pnl' - unitPrice' = valueAfterDate/unitBalance - in (valueOnDate, 0, unitPrice', unitBalance)) - (0, 0, initialUnitPrice, initialUnits) + unitCost' = valueAfterDate/unitBalance + in (valueOnDate, 0, unitCost', unitBalance)) + (0, 0, initialUnitCost, initialUnits) $ dbg3 "changes" changes let finalUnitBalance = if null units then initialUnits else let (_,_,_,u) = last units in u - finalUnitPrice = if finalUnitBalance == 0 then - if null units then initialUnitPrice - else let (_,_,lastUnitPrice,_) = last units in lastUnitPrice + finalUnitCost = if finalUnitBalance == 0 then + if null units then initialUnitCost + else let (_,_,lastUnitCost,_) = last units in lastUnitCost else (unMix valueAfter) / finalUnitBalance - -- Technically, totalTWR should be (100*(finalUnitPrice - initialUnitPrice) / initialUnitPrice), but initalUnitPrice is 100, so 100/100 == 1 - totalTWR = roundTo 2 $ (finalUnitPrice - initialUnitPrice) + -- Technically, totalTWR should be (100*(finalUnitCost - initialUnitCost) / initialUnitCost), but initalUnitCost is 100, so 100/100 == 1 + totalTWR = roundTo 2 $ (finalUnitCost - initialUnitCost) (startYear, _, _) = toGregorian begin years = fromIntegral (diffDays end begin) / (if isLeapYear startYear then 366 else 365) :: Double annualizedTWR = 100*((1+(realToFrac totalTWR/100))**(1/years)-1) :: Double @@ -264,7 +264,7 @@ timeWeightedReturn styles showCashFlow prettyTables investmentsQuery trans mixed dates = add begin dates' cashflows = add valueBeforeAmt cashflows' unitsBoughtOrSold = add initialUnits unitsBoughtOrSold' - unitPrices = add initialUnitPrice unitPrices' + unitPrices = add initialUnitCost unitPrices' unitBalances = add initialUnits unitBalances' TL.putStr $ Tab.render prettyTables id id T.pack @@ -283,7 +283,7 @@ timeWeightedReturn styles showCashFlow prettyTables investmentsQuery trans mixed | udelta <- map showDecimal unitsBoughtOrSold ]) printf "Final unit price: %s/%s units = %s\nTotal TWR: %s%%.\nPeriod: %.2f years.\nAnnualized TWR: %.2f%%\n\n" - (showMixedAmount $ styleAmounts styles valueAfter) (showDecimal finalUnitBalance) (showDecimal finalUnitPrice) (showDecimal totalTWR) years annualizedTWR + (showMixedAmount $ styleAmounts styles valueAfter) (showDecimal finalUnitBalance) (showDecimal finalUnitCost) (showDecimal totalTWR) years annualizedTWR return ((realToFrac totalTWR) :: Double, annualizedTWR)