slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

;lib: refactor, consolidate, add transactionCheckBalanced

Browse Source
This commit is contained in:
Simon Michael 2020-05-29 11:11:47 -07:00
parent ebe021b0c8
commit e6f9f09b41
1 changed files with 31 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -339,21 +339,35 @@ transactionPostingBalances t = (sumPostings $ realPostings t
,sumPostings $ virtualPostings t ,sumPostings $ virtualPostings t
,sumPostings $ balancedVirtualPostings t) ,sumPostings $ balancedVirtualPostings t)
-- | Does this transaction appear balanced when rendered, optionally with the -- | Check that this transaction appears balanced when rendered,
-- given commodity display styles ? More precisely: -- returning an appropriate error message if it is not.
-- after converting amounts to cost using explicit transaction prices if any; -- In more detail: after converting amounts to cost using explicit
-- and summing the real postings, and summing the balanced virtual postings; -- transaction prices if any; and summing the real postings; and
-- and applying the given display styles if any (maybe affecting decimal places); -- summing the balanced virtual postings; and applying the given
-- do both totals appear to be zero when rendered ? -- display styles, if provided (maybe affecting decimal places):
-- do both posting totals appear to be zero when rendered ?
transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Maybe String
transactionCheckBalanced mstyles t
| rbalanced && bvbalanced = Nothing
| otherwise = Just $ printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg
where
(rsum, _, bvsum) = transactionPostingBalances t
(rsumcost, bvsumcost) = (costOfMixedAmount rsum, costOfMixedAmount bvsum)
(rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
where canonicalise = maybe id canonicaliseMixedAmount mstyles
-- for checking balanced, use the display precision
(rbalanced, bvbalanced) = (isZeroMixedAmount rsumdisplay, isZeroMixedAmount bvsumdisplay)
-- for selecting and generating error messages, use the uncanonicalised full precision
-- XXX always correct ?
rmsg | isReallyZeroMixedAmount rsumcost = ""
| otherwise = "real postings are off by " ++ showMixedAmount rsumcost
bvmsg | isReallyZeroMixedAmount bvsumcost = ""
| otherwise = "balanced virtual postings are off by " ++ showMixedAmount bvsumcost
sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String
-- | Legacy form of transactionCheckBalanced.
isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool
isTransactionBalanced styles t = isTransactionBalanced mstyles = (==Nothing) . transactionCheckBalanced mstyles
-- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum
isZeroMixedAmount rsum' && isZeroMixedAmount bvsum'
where
(rsum, _, bvsum) = transactionPostingBalances t
rsum' = canonicalise $ costOfMixedAmount rsum
bvsum' = canonicalise $ costOfMixedAmount bvsum
canonicalise = maybe id canonicaliseMixedAmount styles
-- | Balance this transaction, ensuring that its postings -- | Balance this transaction, ensuring that its postings
-- (and its balanced virtual postings) sum to 0, -- (and its balanced virtual postings) sum to 0,
@ -384,22 +398,9 @@ balanceTransactionHelper ::
balanceTransactionHelper mstyles t = do balanceTransactionHelper mstyles t = do
(t', inferredamtsandaccts) <- (t', inferredamtsandaccts) <-
inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t
if isTransactionBalanced mstyles t' case transactionCheckBalanced mstyles t' of
then Right (txnTieKnot t', inferredamtsandaccts) Nothing -> Right (txnTieKnot t', inferredamtsandaccts)
else Left $ annotateErrorWithTransaction t' $ nonzerobalanceerror t' Just err -> Left $ annotateErrorWithTransaction t' err
where
nonzerobalanceerror :: Transaction -> String
nonzerobalanceerror tt = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg
where
(rsum, _, bvsum) = transactionPostingBalances tt
rmsg | isReallyZeroMixedAmountCost rsum = ""
| otherwise = "real postings are off by "
++ showMixedAmount (costOfMixedAmount rsum)
bvmsg | isReallyZeroMixedAmountCost bvsum = ""
| otherwise = "balanced virtual postings are off by "
++ showMixedAmount (costOfMixedAmount bvsum)
sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String
annotateErrorWithTransaction :: Transaction -> String -> String annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransaction t] annotateErrorWithTransaction t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransaction t]