lib: Include sign in TotalPrice in Amount, rather than relying on the sign of
aquantity.
Journal entries still require a positive @@ price, but now the sign is
set after parsing, rather than when converting in amountToCost.
The reason for this change is that, if we're going to perform arithmetic
on Amount with TotalCost, then the presence of aquantity=0 means that
amountToCost would render the total cost as 0, because signum 0 == 0.
This makes journal entries like the following impossible to balance:
2000-01-01
a 0 @@ 10 A
b -10 A
This commit is contained in:
parent
a65ef7cd19
commit
2ada289e28
@ -209,7 +209,7 @@ instance Num Amount where
|
||||
abs a@Amount{aquantity=q} = a{aquantity=abs q}
|
||||
signum a@Amount{aquantity=q} = a{aquantity=signum q}
|
||||
fromInteger i = nullamt{aquantity=fromInteger i}
|
||||
negate a@Amount{aquantity=q} = a{aquantity= -q}
|
||||
negate a = transformAmountAndPrice negate a
|
||||
(+) = similarAmountsOp (+)
|
||||
(-) = similarAmountsOp (-)
|
||||
(*) = similarAmountsOp (*)
|
||||
@ -260,14 +260,14 @@ amountWithCommodity c a = a{acommodity=c, aprice=Nothing}
|
||||
-- - price amounts must be MixedAmounts with exactly one component Amount
|
||||
-- (or there will be a runtime error XXX)
|
||||
--
|
||||
-- - price amounts should be positive
|
||||
-- - price 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 * signum q}
|
||||
Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq}
|
||||
|
||||
-- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
|
||||
-- Has no effect on amounts without one.
|
||||
@ -293,21 +293,20 @@ divideAmount n a@Amount{aquantity=q} = a{aquantity=q/n}
|
||||
multiplyAmount :: Quantity -> Amount -> Amount
|
||||
multiplyAmount n a@Amount{aquantity=q} = a{aquantity=q*n}
|
||||
|
||||
-- | Divide an amount's quantity (and its total price, if it has one) by a constant.
|
||||
-- The total price will be kept positive regardless of the multiplier's sign.
|
||||
divideAmountAndPrice :: Quantity -> Amount -> Amount
|
||||
divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f <$> p}
|
||||
-- | Apply a function to an amount's quantity (and its total price, if it has one).
|
||||
transformAmountAndPrice :: (Quantity -> Quantity) -> Amount -> Amount
|
||||
transformAmountAndPrice f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p}
|
||||
where
|
||||
f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a
|
||||
f p = p
|
||||
f' (TotalPrice a@Amount{aquantity=pq}) = TotalPrice a{aquantity = f pq}
|
||||
f' p = p
|
||||
|
||||
-- | Divide an amount's quantity (and its total price, if it has one) by a constant.
|
||||
divideAmountAndPrice :: Quantity -> Amount -> Amount
|
||||
divideAmountAndPrice n = transformAmountAndPrice (/n)
|
||||
|
||||
-- | Multiply an amount's quantity (and its total price, if it has one) by a constant.
|
||||
-- The total price will be kept positive regardless of the multiplier's sign.
|
||||
multiplyAmountAndPrice :: Quantity -> Amount -> Amount
|
||||
multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f <$> p}
|
||||
where
|
||||
f (TotalPrice a) = TotalPrice $ abs $ n `multiplyAmount` a
|
||||
f p = p
|
||||
multiplyAmountAndPrice n = transformAmountAndPrice (*n)
|
||||
|
||||
-- | Is this amount negative ? The price is ignored.
|
||||
isNegativeAmount :: Amount -> Bool
|
||||
@ -372,10 +371,12 @@ setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalpoint=mc} }
|
||||
withDecimalPoint :: Amount -> Maybe Char -> Amount
|
||||
withDecimalPoint = flip setAmountDecimalPoint
|
||||
|
||||
showAmountPrice :: Maybe AmountPrice -> WideBuilder
|
||||
showAmountPrice Nothing = mempty
|
||||
showAmountPrice (Just (UnitPrice pa)) = WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour pa
|
||||
showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour pa
|
||||
showAmountPrice :: Amount -> WideBuilder
|
||||
showAmountPrice amt = case aprice amt of
|
||||
Nothing -> mempty
|
||||
Just (UnitPrice pa) -> WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour pa
|
||||
Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour (sign pa)
|
||||
where sign = if aquantity amt < 0 then negate else id
|
||||
|
||||
showAmountPriceDebug :: Maybe AmountPrice -> String
|
||||
showAmountPriceDebug Nothing = ""
|
||||
@ -428,7 +429,7 @@ showAmountB opts a@Amount{astyle=style} =
|
||||
| otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)
|
||||
space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty
|
||||
c' = WideBuilder (TB.fromText c) (textWidth c)
|
||||
price = if displayPrice opts then showAmountPrice (aprice a) else mempty
|
||||
price = if displayPrice opts then showAmountPrice a else mempty
|
||||
color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id
|
||||
|
||||
-- | Colour version. For a negative amount, adds ANSI codes to change the colour,
|
||||
@ -874,7 +875,7 @@ tests_Amount = tests "Amount" [
|
||||
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 (-1)){aprice=Just $ TotalPrice $ usd (-2)} @?= usd (-2)
|
||||
|
||||
,test "amountLooksZero" $ do
|
||||
assertBool "" $ amountLooksZero amount
|
||||
|
||||
@ -553,8 +553,9 @@ priceInferrerFor t pt = inferprice
|
||||
= p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p}
|
||||
where
|
||||
fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
|
||||
totalpricesign = if aquantity a < 0 then negate else id
|
||||
conversionprice
|
||||
| fromcount==1 = TotalPrice $ abs toamount `withPrecision` NaturalPrecision
|
||||
| fromcount==1 = TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision
|
||||
| otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision
|
||||
where
|
||||
fromcount = length $ filter ((==fromcommodity).acommodity) pamounts
|
||||
@ -923,7 +924,7 @@ tests_Transaction =
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "a", pamount = Mixed [usd 1 @@ eur 1]}
|
||||
, posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur 1]}
|
||||
, posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur (-1)]}
|
||||
])
|
||||
]
|
||||
, tests "isTransactionBalanced" [
|
||||
|
||||
@ -757,7 +757,7 @@ amountp = label "amount" $ do
|
||||
spaces = lift $ skipNonNewlineSpaces
|
||||
amount <- amountwithoutpricep <* spaces
|
||||
(mprice, _elotprice, _elotdate) <- runPermutation $
|
||||
(,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp <* spaces)
|
||||
(,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amount <* spaces)
|
||||
<*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces)
|
||||
<*> toPermutationWithDefault Nothing (Just <$> lotdatep <* spaces)
|
||||
pure $ amount { aprice = mprice }
|
||||
@ -767,7 +767,7 @@ amountpnolotpricesp = label "amount" $ do
|
||||
let spaces = lift $ skipNonNewlineSpaces
|
||||
amount <- amountwithoutpricep
|
||||
spaces
|
||||
mprice <- optional $ priceamountp <* spaces
|
||||
mprice <- optional $ priceamountp amount <* spaces
|
||||
pure $ amount { aprice = mprice }
|
||||
|
||||
amountwithoutpricep :: JournalParser m Amount
|
||||
@ -877,18 +877,24 @@ quotedcommoditysymbolp =
|
||||
simplecommoditysymbolp :: TextParser m CommoditySymbol
|
||||
simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar)
|
||||
|
||||
priceamountp :: JournalParser m AmountPrice
|
||||
priceamountp = label "transaction price" $ do
|
||||
priceamountp :: Amount -> JournalParser m AmountPrice
|
||||
priceamountp baseAmt = label "transaction price" $ do
|
||||
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs
|
||||
parenthesised <- option False $ char '(' >> pure True
|
||||
char '@'
|
||||
priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice
|
||||
totalPrice <- char '@' *> pure True <|> pure False
|
||||
when parenthesised $ void $ char ')'
|
||||
|
||||
lift skipNonNewlineSpaces
|
||||
priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)"
|
||||
|
||||
pure $ priceConstructor priceAmount
|
||||
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
|
||||
|
||||
|
||||
balanceassertionp :: JournalParser m BalanceAssertion
|
||||
balanceassertionp = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user