From 2ada289e284df7ac40bd3b8e783e5ce6c587fd86 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 6 Jan 2021 20:46:31 +1100 Subject: [PATCH] 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 --- hledger-lib/Hledger/Data/Amount.hs | 41 +++++++++++++------------ hledger-lib/Hledger/Data/Transaction.hs | 5 +-- hledger-lib/Hledger/Read/Common.hs | 18 +++++++---- 3 files changed, 36 insertions(+), 28 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 8027219b1..91cf2748f 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 222f4e6c7..147d86841 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -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" [ diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index cfe34a701..3d6731493 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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