lib: clarify checkBalanceAssertion etc.
This commit is contained in:
		
							parent
							
								
									d08a97c29e
								
							
						
					
					
						commit
						72eb48bb29
					
				| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user