diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 8027219b1..b62f2c6c5 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -40,6 +40,7 @@ exchange rates. -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -65,8 +66,6 @@ module Hledger.Data.Amount ( amountLooksZero, divideAmount, multiplyAmount, - divideAmountAndPrice, - multiplyAmountAndPrice, amountTotalPriceToUnitPrice, -- ** rendering AmountDisplayOpts(..), @@ -107,8 +106,6 @@ module Hledger.Data.Amount ( mixedAmountCost, divideMixedAmount, multiplyMixedAmount, - divideMixedAmountAndPrice, - multiplyMixedAmountAndPrice, averageMixedAmounts, isNegativeAmount, isNegativeMixedAmount, @@ -140,12 +137,10 @@ module Hledger.Data.Amount ( import Control.Monad (foldM) import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) import Data.Default (Default(..)) -import Data.Function (on) -import Data.List (groupBy, intercalate, intersperse, mapAccumL, partition, - sortBy) +import Data.Foldable (toList) +import Data.List (intercalate, intersperse, mapAccumL, partition) import Data.List.NonEmpty (NonEmpty(..), nonEmpty) -import qualified Data.Map as M -import Data.Map (findWithDefault) +import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) @@ -209,7 +204,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 = transformAmount negate a (+) = similarAmountsOp (+) (-) = similarAmountsOp (-) (*) = similarAmountsOp (*) @@ -242,8 +237,8 @@ amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} -- Prices 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}} - Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} = +similarAmountsOp op !Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}} + !Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} = -- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug) amount{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}} -- c1==c2 || q1==0 || q2==0 = @@ -260,14 +255,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. @@ -285,29 +280,20 @@ amountTotalPriceToUnitPrice Precision p -> Precision $ if p == maxBound then maxBound else p + 1 amountTotalPriceToUnitPrice a = a --- | Divide an amount's quantity by a constant. -divideAmount :: Quantity -> Amount -> Amount -divideAmount n a@Amount{aquantity=q} = a{aquantity=q/n} - --- | Multiply an amount's quantity by a constant. -multiplyAmount :: Quantity -> Amount -> Amount -multiplyAmount n a@Amount{aquantity=q} = a{aquantity=q*n} +-- | Apply a function to an amount's quantity (and its total price, 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 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. --- 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} - where - f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a - f p = p +divideAmount :: Quantity -> Amount -> Amount +divideAmount n = transformAmount (/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 +multiplyAmount :: Quantity -> Amount -> Amount +multiplyAmount n = transformAmount (*n) -- | Is this amount negative ? The price is ignored. isNegativeAmount :: Amount -> Bool @@ -320,14 +306,20 @@ amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} = c NaturalPrecision -> q Precision p' -> roundTo p' q --- | Does mixed amount appear to be zero when rendered with its +-- | 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 + _ -> f amt + +-- | Do this Amount and (and its total price, if it has one) appear to be zero when rendered with its -- display precision ? amountLooksZero :: Amount -> Bool -amountLooksZero = (0==) . amountRoundedQuantity +amountLooksZero = testAmountAndTotalPrice ((0==) . amountRoundedQuantity) --- | Is this amount exactly zero, ignoring its display precision ? +-- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool -amountIsZero Amount{aquantity=q} = q == 0 +amountIsZero = testAmountAndTotalPrice ((0==) . aquantity) -- | Set an amount's display precision, flipped. withPrecision :: Amount -> AmountPrecision -> Amount @@ -372,10 +364,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 +422,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, @@ -495,8 +489,7 @@ applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInte -- | Canonicalise an amount's display style using the provided commodity style map. canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'} - where - s' = findWithDefault s c styles + where s' = M.findWithDefault s c styles ------------------------------------------------------------------------------- -- MixedAmount @@ -538,24 +531,18 @@ normaliseMixedAmount = normaliseHelper False normaliseHelper :: Bool -> MixedAmount -> MixedAmount normaliseHelper squashprices (Mixed as) - | missingamt `elem` as = missingmixedamt -- missingamt should always be alone, but detect it even if not - | null nonzeros = Mixed [newzero] - | otherwise = Mixed nonzeros + | missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not + | M.null nonzeros= Mixed [newzero] + | otherwise = Mixed $ toList nonzeros where - newzero = lastDef nullamt $ filter (not . T.null . acommodity) zeros - (zeros, nonzeros) = partition amountIsZero $ - map sumSimilarAmountsUsingFirstPrice $ - groupBy groupfn $ - sortBy sortfn - as - sortfn | squashprices = compare `on` acommodity - | otherwise = compare `on` \a -> (acommodity a, aprice a) - groupfn | squashprices = (==) `on` acommodity - | otherwise = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2 - - combinableprices Amount{aprice=Nothing} Amount{aprice=Nothing} = True - combinableprices Amount{aprice=Just (UnitPrice p1)} Amount{aprice=Just (UnitPrice p2)} = p1 == p2 - combinableprices _ _ = False + newzero = maybe nullamt snd . M.lookupMin $ M.filter (not . T.null . acommodity) zeros + (zeros, nonzeros) = M.partition amountIsZero amtMap + amtMap = foldr (\a -> M.insertWith sumSimilarAmountsUsingFirstPrice (key a) a) mempty as + key Amount{acommodity=c,aprice=p} = (c, if squashprices then Nothing else priceKey <$> p) + where + priceKey (UnitPrice x) = (acommodity x, Just $ aquantity x) + priceKey (TotalPrice x) = (acommodity x, Nothing) + missingkey = key missingamt -- | Like normaliseMixedAmount, but combine each commodity's amounts -- into just one by throwing away all prices except the first. This is @@ -579,9 +566,13 @@ unifyMixedAmount = foldM combine 0 . amounts -- | Sum same-commodity amounts in a lossy way, applying the first -- price to the result and discarding any other prices. Only used as a -- rendering helper. -sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount -sumSimilarAmountsUsingFirstPrice [] = nullamt -sumSimilarAmountsUsingFirstPrice as = (sumStrict as){aprice=aprice $ head as} +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 } + _ -> aprice a -- -- | Sum same-commodity amounts. If there were different prices, set -- -- the price to a special marker indicating "various". Only used as a @@ -618,24 +609,14 @@ mapMixedAmount f (Mixed as) = Mixed $ map f as mixedAmountCost :: MixedAmount -> MixedAmount mixedAmountCost = mapMixedAmount amountCost --- | Divide a mixed amount's quantities by a constant. +-- | Divide a mixed amount's quantities (and total prices, if any) by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount divideMixedAmount n = mapMixedAmount (divideAmount n) --- | Multiply a mixed amount's quantities by a constant. +-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant. multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount multiplyMixedAmount n = mapMixedAmount (multiplyAmount n) --- | Divide a mixed amount's quantities (and total prices, if any) by a constant. --- The total prices will be kept positive regardless of the multiplier's sign. -divideMixedAmountAndPrice :: Quantity -> MixedAmount -> MixedAmount -divideMixedAmountAndPrice n = mapMixedAmount (divideAmountAndPrice n) - --- | Multiply a mixed amount's quantities (and total prices, if any) by a constant. --- The total prices will be kept positive regardless of the multiplier's sign. -multiplyMixedAmountAndPrice :: Quantity -> MixedAmount -> MixedAmount -multiplyMixedAmountAndPrice n = mapMixedAmount (multiplyAmountAndPrice n) - -- | Calculate the average of some mixed amounts. averageMixedAmounts :: [MixedAmount] -> MixedAmount averageMixedAmounts [] = 0 @@ -652,12 +633,15 @@ isNegativeMixedAmount m = as | not (any isNegativeAmount as) -> Just False _ -> Nothing -- multiple amounts with different signs --- | Does this mixed amount appear to be zero when rendered with its --- display precision ? +-- | Does this mixed amount appear to be zero when rendered with its display precision? +-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero), +-- and zero quantity for each unit price? mixedAmountLooksZero :: MixedAmount -> Bool mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmountSquashPricesForDisplay --- | Is this mixed amount exactly zero, ignoring display precisions ? +-- | Is this mixed amount exactly to be zero, ignoring its display precision? +-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero), +-- and zero quantity for each unit price? mixedAmountIsZero :: MixedAmount -> Bool mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPricesForDisplay @@ -740,10 +724,11 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)" -- maximum width will be elided. showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder showMixedAmountB opts ma - | displayOneLine opts = showMixedAmountOneLineB opts ma + | displayOneLine opts = showMixedAmountOneLineB opts ma' | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width where - lines = showMixedAmountLinesB opts ma + ma' = if displayPrice opts then ma else mixedAmountStripPrices ma + lines = showMixedAmountLinesB opts ma' width = headDef 0 $ map wbWidth lines sep = WideBuilder (TB.singleton '\n') 0 @@ -874,7 +859,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 @@ -915,9 +900,7 @@ tests_Amount = tests "Amount" [ [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ]) - @?= Mixed [usd 1 @@ eur 1 - ,usd (-2) @@ eur 1 - ] + @?= Mixed [usd (-1) @@ eur 2 ] ,test "showMixedAmount" $ do showMixedAmount (Mixed [usd 1]) @?= "$1.00" @@ -940,8 +923,8 @@ tests_Amount = tests "Amount" [ normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1] ,test "amounts with different unit prices are not combined" $ normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2] - ,test "amounts with total prices are not combined" $ - normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1] + ,test "amounts with total prices are combined" $ + normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 2 @@ eur 2] ] ,test "normaliseMixedAmountSquashPricesForDisplay" $ do diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 13a2b73aa..3a18f33a0 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -92,6 +92,7 @@ module Hledger.Data.Journal ( ) where +import Control.Applicative ((<|>)) import Control.Monad.Except (ExceptT(..), runExceptT, throwError) import "extra" Control.Monad.Extra (whenM) import Control.Monad.Reader as R @@ -102,9 +103,9 @@ import Data.Default (Default(..)) import Data.Function ((&)) import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.ST.Cuckoo as H -import Data.List (find, sortOn) -import Data.List.Extra (groupSort, nubSort) -import qualified Data.Map as M +import Data.List (find, foldl', sortOn) +import Data.List.Extra (nubSort) +import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) @@ -1109,42 +1110,40 @@ journalInferCommodityStyles j = -- and this function never reports an error. -- commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle) -commodityStylesFromAmounts amts = - Right $ M.fromList commstyles - where - commamts = groupSort [(acommodity as, as) | as <- amts] - commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] +commodityStylesFromAmounts = + Right . foldr (\a -> M.insertWith canonicalStyle (acommodity a) (astyle a)) mempty + +-- | Given a list of amount styles (assumed to be from parsed amounts +-- in a single commodity), in parse order, choose a canonical style. +canonicalStyleFrom :: [AmountStyle] -> AmountStyle +-- canonicalStyleFrom [] = amountstyle +canonicalStyleFrom ss = foldl' canonicalStyle amountstyle ss -- TODO: should probably detect and report inconsistencies here. -- Though, we don't have the info for a good error message, so maybe elsewhere. --- | Given a list of amount styles (assumed to be from parsed amounts --- in a single commodity), in parse order, choose a canonical style. +-- | Given a pair of AmountStyles, choose a canonical style. -- This is: --- the general style of the first amount, +-- the general style of the first amount, -- with the first digit group style seen, -- with the maximum precision of all. --- -canonicalStyleFrom :: [AmountStyle] -> AmountStyle -canonicalStyleFrom [] = amountstyle -canonicalStyleFrom ss@(s:_) = - s{asprecision=prec, asdecimalpoint=Just decmark, asdigitgroups=mgrps} +canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle +canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=mgrps} where -- precision is maximum of all precisions - prec = maximumStrict $ map asprecision ss + prec = max (asprecision a) (asprecision b) -- identify the digit group mark (& group sizes) - mgrps = headMay $ mapMaybe asdigitgroups ss + mgrps = asdigitgroups a <|> asdigitgroups b -- if a digit group mark was identified above, we can rely on that; -- make sure the decimal mark is different. If not, default to period. - defdecmark = - case mgrps of + defdecmark = case mgrps of Just (DigitGroups '.' _) -> ',' _ -> '.' -- identify the decimal mark: the first one used, or the above default, -- but never the same character as the digit group mark. -- urgh.. refactor.. decmark = case mgrps of - Just _ -> defdecmark - _ -> headDef defdecmark $ mapMaybe asdecimalpoint ss + Just _ -> Just defdecmark + Nothing -> asdecimalpoint a <|> asdecimalpoint b <|> Just defdecmark -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyPriceDirectives :: Journal -> Journal diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 222f4e6c7..cf380a170 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -367,7 +367,7 @@ transactionCheckBalanced mstyles t = errs -- check for mixed signs, detecting nonzeros at display precision canonicalise = maybe id canonicaliseMixedAmount mstyles - signsOk ps = + signsOk ps = case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of nonzeros | length nonzeros >= 2 -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1 @@ -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/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index f11dbf5ce..3a09b03a3 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -120,7 +120,7 @@ tmPostingRuleToFunction querytxt pr = -- Approach 1: convert to a unit price and increase the display precision slightly -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Approach 2: multiply the total price (keeping it positive) as well as the quantity - Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount + Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount in case acommodity pramount of "" -> Mixed as diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 0710c4d67..1afac7ebc 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -178,16 +178,16 @@ instance ToMarkup Quantity -- | An amount's per-unit or total cost/selling price in another -- commodity, as recorded in the journal entry eg with @ or @@. -- Docs call this "transaction price". The amount is always positive. -data AmountPrice = UnitPrice Amount | TotalPrice Amount +data AmountPrice = UnitPrice !Amount | TotalPrice !Amount deriving (Eq,Ord,Generic,Show) -- | Display style for an amount. data AmountStyle = AmountStyle { - ascommodityside :: Side, -- ^ does the symbol appear on the left or the right ? - ascommodityspaced :: Bool, -- ^ space between symbol and quantity ? - asprecision :: !AmountPrecision, -- ^ number of digits displayed after the decimal point - asdecimalpoint :: Maybe Char, -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default" - asdigitgroups :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any + ascommodityside :: !Side, -- ^ does the symbol appear on the left or the right ? + ascommodityspaced :: !Bool, -- ^ space between symbol and quantity ? + asprecision :: !AmountPrecision, -- ^ number of digits displayed after the decimal point + asdecimalpoint :: !(Maybe Char), -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default" + asdigitgroups :: !(Maybe DigitGroupStyle) -- ^ style for displaying digit groups, if any } deriving (Eq,Ord,Read,Generic) instance Show AmountStyle where @@ -211,7 +211,7 @@ data AmountPrecision = Precision !Word8 | NaturalPrecision deriving (Eq,Ord,Read -- point), and the size of each group, starting with the one nearest -- the decimal point. The last group size is assumed to repeat. Eg, -- comma between thousands is DigitGroups ',' [3]. -data DigitGroupStyle = DigitGroups Char [Word8] +data DigitGroupStyle = DigitGroups !Char ![Word8] deriving (Eq,Ord,Read,Show,Generic) type CommoditySymbol = Text @@ -222,12 +222,12 @@ data Commodity = Commodity { } deriving (Show,Eq,Generic) --,Ord) data Amount = Amount { - acommodity :: CommoditySymbol, -- commodity symbol, or special value "AUTO" - aquantity :: Quantity, -- numeric quantity, or zero in case of "AUTO" - aismultiplier :: Bool, -- ^ kludge: a flag marking this amount and posting as a multiplier - -- in a TMPostingRule. In a regular Posting, should always be false. - astyle :: AmountStyle, - aprice :: Maybe AmountPrice -- ^ the (fixed, transaction-specific) price for this amount, if any + acommodity :: !CommoditySymbol, -- commodity symbol, or special value "AUTO" + aquantity :: !Quantity, -- numeric quantity, or zero in case of "AUTO" + aismultiplier :: !Bool, -- ^ kludge: a flag marking this amount and posting as a multiplier + -- in a TMPostingRule. In a regular Posting, should always be false. + astyle :: !AmountStyle, + aprice :: !(Maybe AmountPrice) -- ^ the (fixed, transaction-specific) price for this amount, if any } deriving (Eq,Ord,Generic,Show) newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Generic,Show) 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