diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index f3b19cc5b..3668ded0e 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 09512261b..48921c8da 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -105,6 +105,7 @@ nullsourcepos = JournalSourcePos "" (1,1) nullassertion, assertion :: BalanceAssertion nullassertion = BalanceAssertion {baamount=nullamt + ,baexact=False ,baposition=nullsourcepos } assertion = nullassertion diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index e2936e9d6..84424dd8b 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index eaedd1676..90ed49668 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 } diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 5c0dcae71..440ce8eae 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -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 } diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 5b5eef2c1..1e048cedd 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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" [ diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index cffefdbdd..fab8d357f 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -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