lib: inclusive balance assertions (=* and ==*)

This commit is contained in:
Simon Michael 2019-02-17 19:50:22 -08:00
parent 3b47b58aec
commit 8789a442a8
7 changed files with 130 additions and 85 deletions

View File

@ -733,13 +733,13 @@ inferFromAssignmentB p@Posting{paccount=acc} =
-- checks the posting's balance assertion if any. Or if the posting has no -- checks the posting's balance assertion if any. Or if the posting has no
-- amount, runs the supplied fallback action. -- amount, runs the supplied fallback action.
addAmountAndCheckBalanceAssertionB :: addAmountAndCheckBalanceAssertionB ::
(Posting -> Balancing s Posting) -- ^ fallback action (Posting -> Balancing s Posting) -- ^ fallback action XXX why ?
-> Posting -> Posting
-> Balancing s Posting -> Balancing s Posting
addAmountAndCheckBalanceAssertionB _ p | hasAmount p = do addAmountAndCheckBalanceAssertionB _ p | hasAmount p = do
newAmt <- addToBalanceB (paccount p) (pamount p) newAmt <- addToBalanceB (paccount p) (pamount p)
assrt <- R.reader bsAssrt assrt <- R.reader bsAssrt
lift $ when assrt $ ExceptT $ return $ checkBalanceAssertion p newAmt when assrt $ checkBalanceAssertionB p newAmt
return p return p
addAmountAndCheckBalanceAssertionB fallback p = fallback p addAmountAndCheckBalanceAssertionB fallback p = fallback p
@ -747,66 +747,81 @@ addAmountAndCheckBalanceAssertionB fallback p = fallback p
-- return an error if the assertion is not satisfied. -- return an error if the assertion is not satisfied.
-- If the assertion is partial, unasserted commodities in the actual balance -- If the assertion is partial, unasserted commodities in the actual balance
-- are ignored; if it is total, they will cause the assertion to fail. -- are ignored; if it is total, they will cause the assertion to fail.
checkBalanceAssertion :: Posting -> MixedAmount -> Either String () checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertion p@Posting{pbalanceassertion=Just (BalanceAssertion{baamount,batotal})} actualbal = checkBalanceAssertionB p@Posting{pbalanceassertion=Just (BalanceAssertion{baamount,batotal})} actualbal =
foldl' f (Right ()) assertedamts forM_ assertedamts $ \amt -> checkBalanceAssertionOneCommodityB p amt actualbal
where where
f (Right _) assertedamt = checkBalanceAssertionOneCommodity p assertedamt actualbal assertedamts = baamount : otheramts
f err _ = err where
assertedamts = baamount : otheramts assertedcomm = acommodity baamount
where otheramts | batotal = map (\a -> a{aquantity=0}) $ amounts $ filterMixedAmount ((/=assertedcomm).acommodity) actualbal
assertedcomm = acommodity baamount | otherwise = []
otheramts | batotal = map (\a -> a{ aquantity = 0 }) $ amounts $ filterMixedAmount (\a -> acommodity a /= assertedcomm) actualbal checkBalanceAssertionB _ _ = return ()
| otherwise = []
checkBalanceAssertion _ _ = Right ()
-- | Does this (single commodity) expected balance match the amount of that -- | Does this (single commodity) expected balance match the amount of that
-- commodity in the given (multicommodity) actual balance ? If not, returns a -- commodity in the given (multicommodity) actual balance ? If not, returns a
-- balance assertion failure message based on the provided posting. To match, -- balance assertion failure message based on the provided posting. To match,
-- the amounts must be exactly equal (display precision is ignored here). -- the amounts must be exactly equal (display precision is ignored here).
checkBalanceAssertionOneCommodity :: Posting -> Amount -> MixedAmount -> Either String () -- If the assertion is inclusive, the expected amount is compared with the account's
checkBalanceAssertionOneCommodity p assertedamt actualbal -- subaccount-inclusive balance; otherwise, with the subaccount-exclusive balance.
| pass = Right () checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
| otherwise = Left errmsg checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt actualbal = do
where -- sum the running balances of this account and any subaccounts seen so far
assertedcomm = acommodity assertedamt bals <- R.asks bsBalances
actualbalincommodity = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts actualbal) actualibal <- liftB $ const $ H.foldM
pass = (\bal (acc, amt) -> return $
aquantity if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc
-- traceWith (("asserted:"++).showAmountDebug) then bal + amt
assertedamt == else bal)
aquantity 0
-- traceWith (("actual:"++).showAmountDebug) bals
actualbalincommodity let
errmsg = printf (unlines isinclusive = maybe False bainclusive $ pbalanceassertion p
[ "balance assertion: %s", actualbal'
"\nassertion details:", | isinclusive = actualibal
"date: %s", | otherwise = actualbal
"account: %s", assertedcomm = acommodity assertedamt
"commodity: %s", actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm actualbal'
-- "display precision: %d", pass =
"calculated: %s", -- (at display precision: %s)", aquantity
"asserted: %s", -- (at display precision: %s)", -- traceWith (("asserted:"++).showAmountDebug)
"difference: %s" assertedamt ==
]) aquantity
(case ptransaction p of -- traceWith (("actual:"++).showAmountDebug)
Nothing -> "?" -- shouldn't happen actualbalincomm
Just t -> printf "%s\ntransaction:\n%s"
(showGenericSourcePos pos) errmsg = printf (unlines
(chomp $ showTransaction t) [ "balance assertion: %s",
:: String "\nassertion details:",
where "date: %s",
pos = baposition $ fromJust $ pbalanceassertion p "account: %s%s",
) "commodity: %s",
(showDate $ postingDate p) -- "display precision: %d",
(T.unpack $ paccount p) -- XXX pack "calculated: %s", -- (at display precision: %s)",
assertedcomm "asserted: %s", -- (at display precision: %s)",
-- (asprecision $ astyle actualbalincommodity) -- should be the standard display precision I think "difference: %s"
(show $ aquantity actualbalincommodity) ])
-- (showAmount actualbalincommodity) (case ptransaction p of
(show $ aquantity assertedamt) Nothing -> "?" -- shouldn't happen
-- (showAmount assertedamt) Just t -> printf "%s\ntransaction:\n%s"
(show $ aquantity assertedamt - aquantity actualbalincommodity) (showGenericSourcePos pos)
(chomp $ showTransaction t)
:: String
where
pos = baposition $ fromJust $ pbalanceassertion p
)
(showDate $ postingDate p)
(T.unpack $ paccount p) -- XXX pack
(if isinclusive then " (and subs)" else "" :: String)
assertedcomm
-- (asprecision $ astyle actualbalincommodity) -- should be the standard display precision I think
(show $ aquantity actualbalincomm)
-- (showAmount actualbalincommodity)
(show $ aquantity assertedamt)
-- (showAmount assertedamt)
(show $ aquantity assertedamt - aquantity actualbalincomm)
when (not pass) $ throwError errmsg
-- | Choose and apply a consistent display format to the posting -- | Choose and apply a consistent display format to the posting
-- amounts in each commodity. Each commodity's format is specified by -- amounts in each commodity. Each commodity's format is specified by

View File

@ -105,6 +105,7 @@ nullassertion, assertion :: BalanceAssertion
nullassertion = BalanceAssertion nullassertion = BalanceAssertion
{baamount=nullamt {baamount=nullamt
,batotal=False ,batotal=False
,bainclusive=False
,baposition=nullsourcepos ,baposition=nullsourcepos
} }
assertion = nullassertion assertion = nullassertion

View File

@ -235,7 +235,7 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [
| postingblock <- postingblocks] | postingblock <- postingblocks]
where where
postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amount, assertion, samelinecomment] | amount <- shownAmounts] postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amount, assertion, samelinecomment] | amount <- shownAmounts]
assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p
statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p
where where
-- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
@ -259,6 +259,10 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [
case renderCommentLines (pcomment p) of [] -> ("",[]) case renderCommentLines (pcomment p) of [] -> ("",[])
c:cs -> (c,cs) c:cs -> (c,cs)
-- | Render a balance assertion, as the =[=][*] symbol and expected amount.
showBalanceAssertion BalanceAssertion{..} =
"=" ++ ['=' | batotal] ++ ['*' | bainclusive] ++ " " ++ showAmountWithZeroCommodity baamount
-- | Render a posting, simply. Used in balance assertion errors. -- | Render a posting, simply. Used in balance assertion errors.
-- showPostingLine p = -- showPostingLine p =
-- indent $ -- indent $
@ -374,6 +378,9 @@ storeTransactionB t = liftB $ \bs ->
-- by inferring a missing amount or conversion price(s) if needed. -- by inferring a missing amount or conversion price(s) if needed.
-- Or if balancing is not possible, because of unbalanced amounts or -- Or if balancing is not possible, because of unbalanced amounts or
-- more than one missing amount, returns an error message. -- more than one missing amount, returns an error message.
-- Note this function may be unable to balance some transactions
-- that journalBalanceTransactions/balanceTransactionB can balance
-- (eg ones with balance assignments).
-- Whether postings "sum to 0" depends on commodity display precisions, -- Whether postings "sum to 0" depends on commodity display precisions,
-- so those can optionally be provided. -- so those can optionally be provided.
balanceTransaction :: balanceTransaction ::

View File

@ -278,6 +278,7 @@ instance Show Status where -- custom show.. bad idea.. don't do it..
data BalanceAssertion = BalanceAssertion { data BalanceAssertion = BalanceAssertion {
baamount :: Amount, -- ^ the expected balance in a particular commodity baamount :: Amount, -- ^ the expected balance in a particular commodity
batotal :: Bool, -- ^ disallow additional non-asserted commodities ? batotal :: Bool, -- ^ disallow additional non-asserted commodities ?
bainclusive :: Bool, -- ^ include subaccounts when calculating the actual balance ?
baposition :: GenericSourcePos -- ^ the assertion's file position, for error reporting baposition :: GenericSourcePos -- ^ the assertion's file position, for error reporting
} deriving (Eq,Typeable,Data,Generic,Show) } deriving (Eq,Typeable,Data,Generic,Show)

View File

@ -729,14 +729,16 @@ balanceassertionp = do
sourcepos <- genericSourcePos <$> lift getSourcePos sourcepos <- genericSourcePos <$> lift getSourcePos
char '=' char '='
istotal <- fmap isJust $ optional $ try $ char '=' istotal <- fmap isJust $ optional $ try $ char '='
isinclusive <- fmap isJust $ optional $ try $ char '*'
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
-- this amount can have a price; balance assertions ignore it, -- this amount can have a price; balance assertions ignore it,
-- but balance assignments will use it -- but balance assignments will use it
a <- amountp <?> "amount (for a balance assertion or assignment)" a <- amountp <?> "amount (for a balance assertion or assignment)"
return BalanceAssertion return BalanceAssertion
{ baamount = a { baamount = a
, batotal = istotal , batotal = istotal
, baposition = sourcepos , bainclusive = isinclusive
, baposition = sourcepos
} }
-- Parse a Ledger-style fixed lot price: {=PRICE} -- Parse a Ledger-style fixed lot price: {=PRICE}

View File

@ -337,8 +337,8 @@ Virtual postings have some legitimate uses, but those are few. You can usually f
hledger supports hledger supports
[Ledger-style balance assertions](http://ledger-cli.org/3.0/doc/ledger3.html#Balance-assertions) [Ledger-style balance assertions](http://ledger-cli.org/3.0/doc/ledger3.html#Balance-assertions)
in journal files. in journal files.
These look like `=EXPECTEDBALANCE` following a posting's amount. Eg in These look like, for example, `= EXPECTEDBALANCE` following a posting's amount.
this example we assert the expected dollar balance in accounts a and b after Eg here we assert the expected dollar balance in accounts a and b after
each posting: each posting:
```journal ```journal
@ -355,7 +355,7 @@ After reading a journal file, hledger will check all balance
assertions and report an error if any of them fail. Balance assertions assertions and report an error if any of them fail. Balance assertions
can protect you from, eg, inadvertently disrupting reconciled balances can protect you from, eg, inadvertently disrupting reconciled balances
while cleaning up old entries. You can disable them temporarily with while cleaning up old entries. You can disable them temporarily with
the `--ignore-assertions` flag, which can be useful for the `-I/--ignore-assertions` flag, which can be useful for
troubleshooting or for reading Ledger files. troubleshooting or for reading Ledger files.
### Assertions and ordering ### Assertions and ordering
@ -399,10 +399,10 @@ We could call this a "partial" balance assertion.
To assert the balance of more than one commodity in an account, To assert the balance of more than one commodity in an account,
you can write multiple postings, each asserting one commodity's balance. you can write multiple postings, each asserting one commodity's balance.
You can make a stronger kind of balance assertion, by writing a You can make a stronger "total" balance assertion by writing a
double equals sign (`==EXPECTEDBALANCE`). double equals sign (`== EXPECTEDBALANCE`).
This "complete" balance assertion asserts the absence of other commodities This asserts that there are no other unasserted commodities in the account
(or, that their balance is 0, which to hledger is equivalent.) (or, that their balance is 0).
``` {.journal} ``` {.journal}
2013/1/1 2013/1/1
@ -453,21 +453,16 @@ and because [balance *assignments*](#balance-assignments) do use them (see below
### Assertions and subaccounts ### Assertions and subaccounts
Balance assertions do not count the balance from subaccounts; they check The balance assertions above (`=` and `==`) do not count the balance
the posted account's exclusive balance. For example: from subaccounts; they check the account's exclusive balance only.
You can assert the balance including subaccounts by writing `=*` or `==*`, eg:
```journal ```journal
1/1 2019/1/1
checking:fund 1 = 1 ; post to this subaccount, its balance is now 1 equity:opening balances
checking 1 = 1 ; post to the parent account, its exclusive balance is now 1 checking:a 5
equity checking:b 5
``` checking 1 ==* 11
The balance report's flat mode shows these exclusive balances more clearly:
```shell
$ hledger bal checking --flat
1 checking
1 checking:fund
--------------------
2
``` ```
### Assertions and virtual postings ### Assertions and virtual postings

View File

@ -311,7 +311,7 @@ hledger -f - stats
>>>2 >>>2
>>>=0 >>>=0
# 17. Exact assertions parse correctly # 17. Total assertions (==) parse correctly
hledger -f - stats hledger -f - stats
<<< <<<
2016/1/1 2016/1/1
@ -324,7 +324,7 @@ hledger -f - stats
>>>2 >>>2
>>>=0 >>>=0
# 18. Exact assertions consider entire account # 18. Total assertions consider entire multicommodity amount
hledger -f - stats hledger -f - stats
<<< <<<
2016/1/1 2016/1/1
@ -340,7 +340,7 @@ hledger -f - stats
>>>2 /balance assertion.*line 10, column 15/ >>>2 /balance assertion.*line 10, column 15/
>>>=1 >>>=1
# 19. Mix different commodities and exact assignments # 19. Mix different commodities and total assignments
hledger -f - stats hledger -f - stats
<<< <<<
2016/1/1 2016/1/1
@ -440,3 +440,27 @@ commodity $1000.00
>>>2 /difference: 0\.0001/ >>>2 /difference: 0\.0001/
>>>=1 >>>=1
# 26. Inclusive assertions include balances from subaccounts.
hledger -f- print
<<<
2019/1/1
(a) X1
(a) Y3
(a:b) Y7
(a) 0 =* X1
(a) 0 =* Y10
(a:b) 0 =* Y7
(a:b) 0 ==* Y7
>>>
2019/01/01
(a) X1
(a) Y3
(a:b) Y7
(a) 0 =* X1
(a) 0 =* Y10
(a:b) 0 =* Y7
(a:b) 0 ==* Y7
>>>2
>>>=0