lib: clarify checkBalanceAssertion etc.

This commit is contained in:
Simon Michael 2019-01-06 07:05:14 +00:00
parent d08a97c29e
commit 72eb48bb29

View File

@ -1,5 +1,7 @@
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving, OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-| {-|
@ -569,54 +571,57 @@ journalCheckBalanceAssertions j =
-- | Check a posting's balance assertion and return an error if it -- | Check a posting's balance assertion and return an error if it
-- fails. -- fails.
checkBalanceAssertion :: Posting -> MixedAmount -> Either String () checkBalanceAssertion :: Posting -> MixedAmount -> Either String ()
checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal = checkBalanceAssertion p@Posting{pbalanceassertion=Just (BalanceAssertion{baamount,baexact})} actualbal =
foldl' fold (Right ()) amts foldl' f (Right ()) assertedamts
where fold (Right _) cass = checkBalanceAssertionCommodity p cass bal where
fold err _ = err f (Right _) assertedamt = checkBalanceAssertionCommodity p assertedamt actualbal
amt = baamount ass f err _ = err
amts = amt : if baexact ass assertedamts = baamount : otheramts
then map (\a -> a{ aquantity = 0 }) $ amounts $ filterMixedAmount (\a -> acommodity a /= assertedcomm) bal where
else [] assertedcomm = acommodity baamount
assertedcomm = acommodity amt otheramts | baexact = map (\a -> a{ aquantity = 0 }) $ amounts $ filterMixedAmount (\a -> acommodity a /= assertedcomm) actualbal
| otherwise = []
checkBalanceAssertion _ _ = Right () checkBalanceAssertion _ _ = Right ()
checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String () checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String ()
checkBalanceAssertionCommodity p amt bal checkBalanceAssertionCommodity p assertedamt actualbal
| isReallyZeroAmount diff = Right () | isReallyZeroAmount diff = Right ()
| True = Left err | True = Left err
where assertedcomm = acommodity amt where
actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal) assertedcomm = acommodity assertedamt
diff = amt - actualbal actualbalincommodity = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts actualbal)
diffplus | isNegativeAmount diff == False = "+" diff = assertedamt - actualbalincommodity
| otherwise = "" diffplus | isNegativeAmount diff == False = "+"
err = printf (unlines | otherwise = ""
[ "balance assertion error%s", err = printf (unlines
"after posting:", [ "balance assertion error%s",
"%s", "after posting:",
"balance assertion details:", "%s",
"date: %s", "balance assertion details:",
"account: %s", "date: %s",
"commodity: %s", "account: %s",
"calculated: %s", "commodity: %s",
"asserted: %s (difference: %s)" "calculated: %s",
]) "asserted: %s (difference: %s)"
(case ptransaction p of ])
Nothing -> ":" -- shouldn't happen (case ptransaction p of
Just t -> printf " in %s:\nin transaction:\n%s" Nothing -> ":" -- shouldn't happen
(showGenericSourcePos pos) (chomp $ showTransaction t) :: String Just t -> printf " in %s:\nin transaction:\n%s"
where pos = baposition $ fromJust $ pbalanceassertion p) (showGenericSourcePos pos) (chomp $ showTransaction t) :: String
(showPostingLine p) where pos = baposition $ fromJust $ pbalanceassertion p)
(showDate $ postingDate p) (showPostingLine p)
(T.unpack $ paccount p) -- XXX pack (showDate $ postingDate p)
assertedcomm (T.unpack $ paccount p) -- XXX pack
(showAmount actualbal) assertedcomm
(showAmount amt) (showAmount actualbalincommodity)
(diffplus ++ showAmount diff) (showAmount assertedamt)
(diffplus ++ showAmount diff)
-- | Fill in any missing amounts and check that all journal transactions -- | Fill in any missing amounts and check that all journal transactions
-- balance, or return an error message. This is done after parsing all -- balance and all balance assertions pass, or return an error message.
-- amounts and applying canonical commodity styles, since balancing -- This is done after parsing all amounts and applying canonical
-- depends on display precision. Reports only the first error encountered. -- commodity styles, since balancing depends on display precision.
-- Reports only the first error encountered.
journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions assrt j = journalBalanceTransactions assrt j =
runST $ journalBalanceTransactionsST runST $ journalBalanceTransactionsST
@ -627,6 +632,8 @@ journalBalanceTransactions assrt j =
(fmap (\txns -> j{ jtxns = txns}) . getElems) -- summarise state (fmap (\txns -> j{ jtxns = txns}) . getElems) -- summarise state
-- | Helper used by 'journalBalanceTransactions' and 'journalCheckBalanceAssertions'. -- | Helper used by 'journalBalanceTransactions' and 'journalCheckBalanceAssertions'.
-- Balances transactions, applies balance assignments, and checks balance assertions
-- at the same time.
journalBalanceTransactionsST :: journalBalanceTransactionsST ::
Bool Bool
-> Journal -> Journal