From 41b60bbcfc92c1abd87481d0b1800275f0b5be98 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 27 Feb 2010 18:06:29 +0000 Subject: [PATCH] when a transaction is unbalanced, show by how much; refactor --- Commands/Add.hs | 6 +++--- hledger-lib/Ledger/Amount.hs | 5 +++++ hledger-lib/Ledger/Transaction.hs | 36 +++++++++++++++++++++++++------ tests/unbalanced.test | 2 +- tests/unicode-error-message.test | 2 +- 5 files changed, 40 insertions(+), 11 deletions(-) diff --git a/Commands/Add.hs b/Commands/Add.hs index 74bbb7ff3..c5f7ff4a7 100644 --- a/Commands/Add.hs +++ b/Commands/Add.hs @@ -71,10 +71,10 @@ getTransaction l opts args defaultDate = do ,tdescription=description ,tpostings=ps } - retry = do - hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:" + retry msg = do + hPutStrLn stderr $ "\n" ++ msg ++ "please re-enter." getpostingsandvalidate - either (const retry) (return . flip (,) date) $ balanceTransaction t + either retry (return . flip (,) date) $ balanceTransaction t unless (null historymatches) (do hPutStrLn stderr "Similar transactions found, using the first for defaults:\n" diff --git a/hledger-lib/Ledger/Amount.hs b/hledger-lib/Ledger/Amount.hs index 1362dc42a..893f91136 100644 --- a/hledger-lib/Ledger/Amount.hs +++ b/hledger-lib/Ledger/Amount.hs @@ -164,6 +164,11 @@ isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount isReallyZeroMixedAmount :: MixedAmount -> Bool isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount +-- | Is this mixed amount "really" zero, after converting to cost +-- commodities where possible ? +isReallyZeroMixedAmountCost :: MixedAmount -> Bool +isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount + -- | 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/hledger-lib/Ledger/Transaction.hs b/hledger-lib/Ledger/Transaction.hs index 52c32e1c2..a95793130 100644 --- a/hledger-lib/Ledger/Transaction.hs +++ b/hledger-lib/Ledger/Transaction.hs @@ -14,7 +14,6 @@ import Ledger.Posting import Ledger.Amount import Ledger.Commodity (dollars, dollar, unknown) - instance Show Transaction where show = showTransactionUnelided instance Show ModifierTransaction where @@ -98,10 +97,27 @@ showAccountName w = fmt parenthesise s = "("++s++")" bracket s = "["++s++"]" +realPostings :: Transaction -> [Posting] +realPostings = filter isReal . tpostings + +virtualPostings :: Transaction -> [Posting] +virtualPostings = filter isVirtual . tpostings + +balancedVirtualPostings :: Transaction -> [Posting] +balancedVirtualPostings = filter isBalancedVirtual . tpostings + +-- | Get the sums of a transaction's real, virtual, and balanced virtual postings. +transactionPostingBalances :: Transaction -> (MixedAmount,MixedAmount,MixedAmount) +transactionPostingBalances t = (sumPostings $ realPostings t + ,sumPostings $ virtualPostings t + ,sumPostings $ balancedVirtualPostings t) + +-- | Is this transaction balanced ? A balanced transaction's real +-- (non-virtual) postings sum to 0, and any balanced virtual postings +-- also sum to 0. isTransactionBalanced :: Transaction -> Bool -isTransactionBalanced (Transaction {tpostings=ps}) = - all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount) - [filter isReal ps, filter isBalancedVirtual ps] +isTransactionBalanced t = isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum + where (rsum, _, bvsum) = transactionPostingBalances t -- | Ensure that this entry is balanced, possibly auto-filling a missing -- amount first. We can auto-fill if there is just one non-virtual @@ -111,7 +127,7 @@ isTransactionBalanced (Transaction {tpostings=ps}) = balanceTransaction :: Transaction -> Either String Transaction balanceTransaction t@Transaction{tpostings=ps} | length missingamounts' > 1 = Left $ printerr "could not balance this transaction (too many missing amounts)" - | not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror + | not $ isTransactionBalanced t' = Left $ printerr $ nonzerobalanceerror t' | otherwise = Right t' where (withamounts, missingamounts) = partition hasAmount $ filter isReal ps @@ -125,7 +141,15 @@ balanceTransaction t@Transaction{tpostings=ps} where otherstotal = sum $ map pamount withamounts printerr s = unlines [s, showTransactionUnelided t] -nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero" +nonzerobalanceerror :: Transaction -> String +nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg + where + (rsum, _, bvsum) = transactionPostingBalances t + rmsg | isReallyZeroMixedAmountCost rsum = "" + | otherwise = "real postings are off by " ++ show rsum + bvmsg | isReallyZeroMixedAmountCost bvsum = "" + | otherwise = "balanced virtual postings are off by " ++ show bvsum + sep = if not (null rmsg) && not (null bvmsg) then "; " else "" -- | Convert the primary date to either the actual or effective date. ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction diff --git a/tests/unbalanced.test b/tests/unbalanced.test index bdc00cfb9..a256f00fe 100644 --- a/tests/unbalanced.test +++ b/tests/unbalanced.test @@ -6,7 +6,7 @@ >>>2 "-" (line 4, column 1): unexpected end of input -could not balance this transaction, amounts do not add up to zero: +could not balance this transaction (real postings are off by 0.1): 2009/01/01 a b 1.1 c -1 diff --git a/tests/unicode-error-message.test b/tests/unicode-error-message.test index 2c8463435..16fe0618f 100644 --- a/tests/unicode-error-message.test +++ b/tests/unicode-error-message.test @@ -6,7 +6,7 @@ >>>2 "-" (line 4, column 1): unexpected end of input -could not balance this transaction, amounts do not add up to zero: +could not balance this transaction (real postings are off by -1): 2009/01/01 broken entry дебит 1 кредит -2