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

dev: AmountPrice,UnitPrice,TotalPrice -> AmountCost,UnitCost,TotalCost; related renames

Browse Source
This commit is contained in:
Simon Michael 2024-01-23 07:38:59 -10:00
parent e201775e93
commit 8102bd9c2b
11 changed files with 135 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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]
]

8
hledger-lib/Hledger/Data/Balancing.hs
View File

@ -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

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

@ -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

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

@ -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

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

@ -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.

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

@ -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)

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

@ -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

50
hledger-lib/Hledger/Data/Types.hs
View File

@ -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)

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

@ -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

14
hledger-lib/Hledger/Read/Common.hs
View File

@ -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

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

@ -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)