lib: journal: Add support for exact assertions

This commit is contained in:
Samuel May 2018-10-11 23:17:16 -07:00 committed by Simon Michael
parent 6c31393dd3
commit e57ef9e9a9
7 changed files with 76 additions and 7 deletions

View File

@ -568,11 +568,22 @@ journalCheckBalanceAssertions j =
-- | Check a posting's balance assertion and return an error if it
-- fails.
checkBalanceAssertion :: Posting -> MixedAmount -> Either String ()
checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal
checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal =
foldl' fold (Right ()) amts
where fold (Right _) cass = checkBalanceAssertionCommodity p cass bal
fold err _ = err
amt = baamount ass
amts = amt : if baexact ass
then map (\a -> a{ aquantity = 0 }) $ amounts $ filterMixedAmount (\a -> acommodity a /= assertedcomm) bal
else []
assertedcomm = acommodity amt
checkBalanceAssertion _ _ = Right ()
checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String ()
checkBalanceAssertionCommodity p amt bal
| isReallyZeroAmount diff = Right ()
| True = Left err
where amt = baamount ass
assertedcomm = acommodity amt
where assertedcomm = acommodity amt
actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal)
diff = amt - actualbal
diffplus | isNegativeAmount diff == False = "+"
@ -600,7 +611,6 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal
(showAmount actualbal)
(showAmount amt)
(diffplus ++ showAmount diff)
checkBalanceAssertion _ _ = Right ()
-- | Fill in any missing amounts and check that all journal transactions
-- balance, or return an error message. This is done after parsing all
@ -720,7 +730,10 @@ checkInferAndRegisterAmounts (Right oldTx) = do
inferFromAssignment p = do
let acc = paccount p
case pbalanceassertion p of
Just ba -> do
Just ba | baexact ba -> do
diff <- setMixedBalance acc $ Mixed [baamount ba]
fullPosting diff p
Just ba | otherwise -> do
old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc
let amt = baamount ba
assertedcomm = acommodity amt

View File

@ -105,6 +105,7 @@ nullsourcepos = JournalSourcePos "" (1,1)
nullassertion, assertion :: BalanceAssertion
nullassertion = BalanceAssertion
{baamount=nullamt
,baexact=False
,baposition=nullsourcepos
}
assertion = nullassertion

View File

@ -236,8 +236,11 @@ instance Show Status where -- custom show.. bad idea.. don't do it..
show Pending = "!"
show Cleared = "*"
-- | The amount to compare an account's balance to, to verify that the history
-- leading to a given point is correct or to set the account to a known value.
data BalanceAssertion = BalanceAssertion {
baamount :: Amount,
baamount :: Amount, -- ^ the expected value of a particular commodity
baexact :: Bool, -- ^ whether the assertion is exclusive, and doesn't allow other commodities alongside 'baamount'
baposition :: GenericSourcePos
} deriving (Eq,Typeable,Data,Generic,Show)

View File

@ -721,10 +721,12 @@ balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp = do
sourcepos <- genericSourcePos <$> lift getSourcePos
char '='
exact <- optional $ try $ char '='
lift (skipMany spacenonewline)
a <- amountp <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
return BalanceAssertion
{ baamount = a
, baexact = isJust exact
, baposition = sourcepos
}

View File

@ -752,7 +752,7 @@ transactionFromCsvRecord sourcepos rules record = t
,posting {paccount=account2, pamount=amount2, ptransaction=Just t}
]
}
toAssertion (a, b) = BalanceAssertion{
toAssertion (a, b) = assertion{
baamount = a,
baposition = b
}

View File

@ -730,6 +730,8 @@ tests_JournalReader = tests "JournalReader" [
,test "quoted commodity symbol with digits" $ expectParse (postingp Nothing) " a 1 \"DE123\"\n"
,test "balance assertion and fixed lot price" $ expectParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n"
,test "balance assertion over entire contents of account" $ expectParse (postingp Nothing) " a $1 == $1\n"
]
,tests "transactionmodifierp" [

View File

@ -308,3 +308,51 @@ hledger -f - stats
>>> /Transactions/
>>>2
>>>=0
# 17. Exact assertions parse correctly
hledger -f - stats
<<<
2016/1/1
a $1
b
2016/1/2
a == $1
>>> /Transactions/
>>>2
>>>=0
# 18. Exact assertions consider entire account
hledger -f - stats
<<<
2016/1/1
a $1
b
2016/1/2
a 1 zorkmids
b
2016/1/3
a 0 == $1
>>>2 /balance assertion error.*line 10, column 15/
>>>=1
# 19. Mix different commodities and exact assignments
hledger -f - stats
<<<
2016/1/1
a $1
a -1 zorkmids
b
2016/1/2
a == $1
b -1 zorkmids
2016/1/3
b 0 = $-1
b 0 = 0 zorkmids
>>> /Transactions/
>>>2
>>>=0