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