;lib: refactor transactionCheckBalanced

This commit is contained in:
Simon Michael 2020-05-29 17:57:10 -07:00
parent 7bcc205622
commit 1087e790cf

View File

@ -340,11 +340,11 @@ transactionsPostings = concatMap tpostings
--
-- 1. Convert amounts to cost where possible
--
-- 2. When there are multiple amounts which appear non-zero when displayed
-- (using the given display styles if provided),
-- 2. When there are two or more non-zero amounts
-- (appearing non-zero when displayed, using the given display styles if provided),
-- are they a mix of positives and negatives ?
-- This is checked separately to give a clearer error message.
-- (Best effort, could be confused by postings with multicommodity amounts.)
-- (Best effort; could be confused by postings with multicommodity amounts.)
--
-- 3. Does the amounts' sum appear non-zero when displayed ?
-- (using the given display styles if provided)
@ -353,32 +353,33 @@ transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transac
transactionCheckBalanced mstyles t = errs
where
(rps, bvps) = (realPostings t, balancedVirtualPostings t)
canonicalise = maybe id canonicaliseMixedAmount mstyles
-- check mixed signs, detecting nonzeros at display precision
nonZeros ps = filter (not.isZeroMixedAmount) $ map (canonicalise.costOfMixedAmount.pamount) ps
-- check for mixed signs, detecting nonzeros at display precision
canonicalise = maybe id canonicaliseMixedAmount mstyles
signsOk ps =
case nonZeros ps of
nzs | length nzs > 1 -> length (nubSort $ mapMaybe isNegativeMixedAmount nzs) > 1
case filter (not.isZeroMixedAmount) $ map (canonicalise.costOfMixedAmount.pamount) ps of
nonzeros | length nonzeros >= 2
-> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1
_ -> True
(rsignsok, bvsignsok) = (signsOk rps, signsOk bvps)
-- check zero sum, at display precision
-- check for zero sum, at display precision
(rsum, bvsum) = (sumPostings rps, sumPostings bvps)
(rsumcost, bvsumcost) = (costOfMixedAmount rsum, costOfMixedAmount bvsum)
(rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
(rzerosum, bvzerosum) = (isZeroMixedAmount rsumdisplay, isZeroMixedAmount bvsumdisplay)
(rsumok, bvsumok) = (isZeroMixedAmount rsumdisplay, isZeroMixedAmount bvsumdisplay)
-- select & generate error messages, showing amounts with their original precision
-- generate error messages, showing amounts with their original precision
errs = filter (not.null) [rmsg, bvmsg]
where
rmsg
| not rsignsok = "real postings all have the same sign"
| not rzerosum = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost
| not rsumok = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost
| otherwise = ""
bvmsg
| not bvsignsok = "balanced virtual postings all have the same sign"
| not bvzerosum = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost
| not bvsumok = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost
| otherwise = ""
errs = filter (not.null) [rmsg, bvmsg]
-- | Legacy form of transactionCheckBalanced.
isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool