From ab5350e02c22438e52013e0b2dc8cf678e666a28 Mon Sep 17 00:00:00 2001
From: Stephen Morgan <morgan.stephen99@gmail.com>
Date: Fri, 17 Sep 2021 22:03:09 +1000
Subject: [PATCH] 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.
---
 hledger-lib/Hledger/Data/Amount.hs      |  8 +++++---
 hledger-lib/Hledger/Data/Transaction.hs | 15 ++++++++++-----
 2 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs
index 10e1c79f8..6d76a1a7c 100644
--- a/hledger-lib/Hledger/Data/Amount.hs
+++ b/hledger-lib/Hledger/Data/Amount.hs
@@ -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.
diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs
index 9b6840867..1c8ac0e88 100644
--- a/hledger-lib/Hledger/Data/Transaction.hs
+++ b/hledger-lib/Hledger/Data/Transaction.hs
@@ -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