From b103f6a0d84018724b7bbfe054bd93b9215b0668 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 16 May 2009 22:54:12 +0000
Subject: [PATCH] be more accurate about checking balanced amounts, don't rely
 on display precision

---
 Ledger/Amount.hs            | 12 ++++++++++--
 Ledger/LedgerTransaction.hs |  2 +-
 Tests.hs                    | 10 ++++++++++
 3 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs
index 6f555025b..97dadde2d 100644
--- a/Ledger/Amount.hs
+++ b/Ledger/Amount.hs
@@ -126,8 +126,12 @@ punctuatethousands s =
 
 -- | Does this amount appear to be zero when displayed with its given precision ?
 isZeroAmount :: Amount -> Bool
-isZeroAmount a = nonzerodigits == ""
-    where nonzerodigits = filter (`elem` "123456789") $ showAmount a
+isZeroAmount a = null $ filter (`elem` "123456789") $ showAmount a
+
+-- | Is this amount "really" zero, regardless of the display precision ?
+-- Since we are using floating point, for now just test to some high precision.
+isReallyZeroAmount :: Amount -> Bool
+isReallyZeroAmount a = null $ filter (`elem` "123456789") $ printf "%.10f" $ quantity a
 
 -- | Access a mixed amount's components.
 amounts :: MixedAmount -> [Amount]
@@ -138,6 +142,10 @@ amounts (Mixed as) = as
 isZeroMixedAmount :: MixedAmount -> Bool
 isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount
 
+-- | Is this mixed amount "really" zero ? See isReallyZeroAmount.
+isReallyZeroMixedAmount :: MixedAmount -> Bool
+isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount
+
 -- | MixedAmount derives Eq in Types.hs, but that doesn't know that we
 -- want $0 = EUR0 = 0. Yet we don't want to drag all this code in there.
 -- When zero equality is important, use this, for now; should be used
diff --git a/Ledger/LedgerTransaction.hs b/Ledger/LedgerTransaction.hs
index 8c3240280..bca338cd8 100644
--- a/Ledger/LedgerTransaction.hs
+++ b/Ledger/LedgerTransaction.hs
@@ -82,7 +82,7 @@ showLedgerTransaction' elide t =
 
 isLedgerTransactionBalanced :: LedgerTransaction -> Bool
 isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) = 
-    isZeroMixedAmount $ costOfMixedAmount $ sum $ map pamount $ filter isReal ps
+    isReallyZeroMixedAmount $ costOfMixedAmount $ sum $ map pamount $ filter isReal ps
 
 -- | Ensure that this entry is balanced, possibly auto-filling a missing
 -- amount first. We can auto-fill if there is just one non-virtual
diff --git a/Tests.hs b/Tests.hs
index bbbff27f6..96a2ed671 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -81,6 +81,16 @@ $ hledger -f sample.ledger balance --depth 1
                   $1  liabilities
 @
 
+@
+$ printf "2009/1/1 a\n  b  1.1\n  c  -1\n" | runhaskell hledger.hs -f- reg 2>&1 ; true
+hledger.hs: could not balance this transaction, amounts do not add up to zero:
+2009/01/01 a
+    b                                            1.1
+    c                                             -1
+
+
+@
+
 Unicode input/output tests
 
 -- layout of the balance command with unicode names