ref: performance: Improve performance for some high-use functions.

mixedAmount(Looks|Is)Zero now operate directly on the MixedAmount,
rather than converting them to a list of amounts first.

mixedAmountCost no longer reconstructs the entire MixedAmount when there
are amounts with no cost.

transactionCheckBalanced only checks if signs are okay if sums are not
okay. It also only traverses the list of postings once when picking real
and balanced virtual postings.
This commit is contained in:
Stephen Morgan 2021-09-17 22:03:09 +10:00 committed by Simon Michael
parent a2d7ac5318
commit ab5350e02c
2 changed files with 15 additions and 8 deletions

View File

@ -646,13 +646,13 @@ isNegativeMixedAmount m =
-- 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 . normaliseMixedAmount
mixedAmountLooksZero (Mixed ma) = all amountLooksZero ma
-- | Is this mixed amount exactly 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 . normaliseMixedAmount
mixedAmountIsZero (Mixed ma) = all amountIsZero ma
-- | Is this mixed amount exactly zero, ignoring its display precision?
--
@ -766,7 +766,9 @@ mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma -- Use M.map instead of
-- | Convert all component amounts to cost/selling price where
-- possible (see amountCost).
mixedAmountCost :: MixedAmount -> MixedAmount
mixedAmountCost = mapMixedAmount amountCost
mixedAmountCost (Mixed ma) =
foldl' (\m a -> maAddAmount m (amountCost a)) (Mixed noPrices) withPrices
where (noPrices, withPrices) = 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.

View File

@ -389,7 +389,12 @@ defbalancingopts = BalancingOpts
transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
where
(rps, bvps) = (realPostings t, balancedVirtualPostings t)
(rps, bvps) = foldr partitionPosting ([], []) $ tpostings t
where
partitionPosting p ~(l, r) = case ptype p of
RegularPosting -> (p:l, r)
BalancedVirtualPosting -> (l, p:r)
VirtualPosting -> (l, r)
-- check for mixed signs, detecting nonzeros at display precision
canonicalise = maybe id canonicaliseMixedAmount commodity_styles_
@ -410,13 +415,13 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
errs = filter (not.null) [rmsg, bvmsg]
where
rmsg
| rsumok = ""
| not rsignsok = "real postings all have the same sign"
| not rsumok = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost
| otherwise = ""
| otherwise = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost
bvmsg
| bvsumok = ""
| not bvsignsok = "balanced virtual postings all have the same sign"
| not bvsumok = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost
| otherwise = ""
| otherwise = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost
-- | Legacy form of transactionCheckBalanced.
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool