lib: include source info in txn balance errors

Partially address simonmichael/hledger#904
This commit is contained in:
Mykola Orliuk 2018-10-24 00:23:26 +02:00 committed by Simon Michael
parent 119e1e3a49
commit 1aac38d3d3
2 changed files with 35 additions and 8 deletions

View File

@ -335,13 +335,13 @@ balanceTransactionUpdate :: MonadError String m
-> Maybe (Map.Map CommoditySymbol AmountStyle) -> Maybe (Map.Map CommoditySymbol AmountStyle)
-> Transaction -> m Transaction -> Transaction -> m Transaction
balanceTransactionUpdate update mstyles t = balanceTransactionUpdate update mstyles t =
finalize =<< inferBalancingAmount update (fromMaybe Map.empty mstyles) t (finalize =<< inferBalancingAmount update (fromMaybe Map.empty mstyles) t)
`catchError` (throwError . annotateErrorWithTxn t)
where where
finalize t' = let t'' = inferBalancingPrices t' finalize t' = let t'' = inferBalancingPrices t'
in if isTransactionBalanced mstyles t'' in if isTransactionBalanced mstyles t''
then return $ txnTieKnot t'' then return $ txnTieKnot t''
else throwError $ printerr $ nonzerobalanceerror t'' else throwError $ nonzerobalanceerror t''
printerr s = intercalate "\n" [s, showTransactionUnelided t]
nonzerobalanceerror :: Transaction -> String nonzerobalanceerror :: Transaction -> String
nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg
where where
@ -354,6 +354,8 @@ balanceTransactionUpdate update mstyles t =
++ showMixedAmount (costOfMixedAmount bvsum) ++ showMixedAmount (costOfMixedAmount bvsum)
sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String
annotateErrorWithTxn t e = intercalate "\n" [showGenericSourcePos $ tsourcepos t, e, showTransactionUnelided t]
-- | Infer up to one missing amount for this transactions's real postings, and -- | Infer up to one missing amount for this transactions's real postings, and
-- likewise for its balanced virtual postings, if needed; or return an error -- likewise for its balanced virtual postings, if needed; or return an error
-- message if we can't. -- message if we can't.
@ -368,14 +370,13 @@ inferBalancingAmount :: MonadError String m =>
-> m Transaction -> m Transaction
inferBalancingAmount update styles t@Transaction{tpostings=ps} inferBalancingAmount update styles t@Transaction{tpostings=ps}
| length amountlessrealps > 1 | length amountlessrealps > 1
= throwError $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)" = throwError "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"
| length amountlessbvps > 1 | length amountlessbvps > 1
= throwError $ printerr "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)" = throwError "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"
| otherwise | otherwise
= do postings <- mapM inferamount ps = do postings <- mapM inferamount ps
return t{tpostings=postings} return t{tpostings=postings}
where where
printerr s = intercalate "\n" [s, showTransactionUnelided t]
(amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t) (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
realsum = sumStrict $ map pamount amountfulrealps realsum = sumStrict $ map pamount amountfulrealps
(amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t) (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)

View File

@ -34,7 +34,12 @@ $ hledger -f - print
# 3. So in these tests we must sometimes force the desired format, like so. # 3. So in these tests we must sometimes force the desired format, like so.
# Now we see the error from the journal reader. # Now we see the error from the journal reader.
$ hledger -f journal:- print $ hledger -f journal:- print
>2 /hledger: could not balance this transaction \(real postings are off by 1\)/ >2 /could not balance this transaction \(real postings are off by 1\)/
>=1
# 4. We expect to have reference to line number with last posting
$ hledger -f journal:- print
>2 /\<2\>/
>=1 >=1
# A posting without two spaces between account and amount. # A posting without two spaces between account and amount.
@ -42,7 +47,7 @@ $ hledger -f journal:- print
2018/1/1 2018/1/1
(a) 1 (a) 1
# 4. hledger doesn't detect this as an error directly, it parses account name "(a) 1" and # 5. hledger doesn't detect this as an error directly, it parses account name "(a) 1" and
# amount 0 here. # amount 0 here.
$ hledger -f - print -x $ hledger -f - print -x
2018/01/01 2018/01/01
@ -50,3 +55,24 @@ $ hledger -f - print -x
>= >=
# 6. Two (or more) postings with implicit amount cannot be balanced.
<
2018/1/1
a 1
b
c
$ hledger -f journal:- print
>2 /\<4\>/
>=1
# 7. Two (or more) virtual postings with implicit amount cannot be balanced.
<
2018/1/1
[a] 1
[b]
[c]
$ hledger -f journal:- print
>2 /\<4\>/
>=1