lib: journal: Add support for exact assertions
This commit is contained in:
		
							parent
							
								
									6c31393dd3
								
							
						
					
					
						commit
						e57ef9e9a9
					
				@ -568,11 +568,22 @@ 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 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 ()
 | 
					  | isReallyZeroAmount diff = Right ()
 | 
				
			||||||
  | True    = Left err
 | 
					  | True    = Left err
 | 
				
			||||||
    where amt = baamount ass
 | 
					    where assertedcomm = acommodity amt
 | 
				
			||||||
          assertedcomm = acommodity amt
 | 
					 | 
				
			||||||
          actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal)
 | 
					          actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal)
 | 
				
			||||||
          diff = amt - actualbal
 | 
					          diff = amt - actualbal
 | 
				
			||||||
          diffplus | isNegativeAmount diff == False = "+"
 | 
					          diffplus | isNegativeAmount diff == False = "+"
 | 
				
			||||||
@ -600,7 +611,6 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal
 | 
				
			|||||||
            (showAmount actualbal)
 | 
					            (showAmount actualbal)
 | 
				
			||||||
            (showAmount amt)
 | 
					            (showAmount amt)
 | 
				
			||||||
            (diffplus ++ showAmount diff)
 | 
					            (diffplus ++ showAmount diff)
 | 
				
			||||||
checkBalanceAssertion _ _ = Right ()
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | 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, or return an error message. This is done after parsing all
 | 
				
			||||||
@ -720,7 +730,10 @@ checkInferAndRegisterAmounts (Right oldTx) = do
 | 
				
			|||||||
    inferFromAssignment p = do
 | 
					    inferFromAssignment p = do
 | 
				
			||||||
      let acc = paccount p
 | 
					      let acc = paccount p
 | 
				
			||||||
      case pbalanceassertion p of
 | 
					      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
 | 
					          old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc
 | 
				
			||||||
          let amt = baamount ba
 | 
					          let amt = baamount ba
 | 
				
			||||||
              assertedcomm = acommodity amt
 | 
					              assertedcomm = acommodity amt
 | 
				
			||||||
 | 
				
			|||||||
@ -105,6 +105,7 @@ nullsourcepos = JournalSourcePos "" (1,1)
 | 
				
			|||||||
nullassertion, assertion :: BalanceAssertion
 | 
					nullassertion, assertion :: BalanceAssertion
 | 
				
			||||||
nullassertion = BalanceAssertion
 | 
					nullassertion = BalanceAssertion
 | 
				
			||||||
                  {baamount=nullamt
 | 
					                  {baamount=nullamt
 | 
				
			||||||
 | 
					                  ,baexact=False
 | 
				
			||||||
                  ,baposition=nullsourcepos
 | 
					                  ,baposition=nullsourcepos
 | 
				
			||||||
                  }
 | 
					                  }
 | 
				
			||||||
assertion = nullassertion
 | 
					assertion = nullassertion
 | 
				
			||||||
 | 
				
			|||||||
@ -236,8 +236,11 @@ instance Show Status where -- custom show.. bad idea.. don't do it..
 | 
				
			|||||||
  show Pending   = "!"
 | 
					  show Pending   = "!"
 | 
				
			||||||
  show Cleared   = "*"
 | 
					  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 {
 | 
					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
 | 
					      baposition :: GenericSourcePos
 | 
				
			||||||
    } deriving (Eq,Typeable,Data,Generic,Show)
 | 
					    } deriving (Eq,Typeable,Data,Generic,Show)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -721,10 +721,12 @@ balanceassertionp :: JournalParser m BalanceAssertion
 | 
				
			|||||||
balanceassertionp = do
 | 
					balanceassertionp = do
 | 
				
			||||||
  sourcepos <- genericSourcePos <$> lift getSourcePos
 | 
					  sourcepos <- genericSourcePos <$> lift getSourcePos
 | 
				
			||||||
  char '='
 | 
					  char '='
 | 
				
			||||||
 | 
					  exact <- optional $ try $ char '='
 | 
				
			||||||
  lift (skipMany spacenonewline)
 | 
					  lift (skipMany spacenonewline)
 | 
				
			||||||
  a <- amountp <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
 | 
					  a <- amountp <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
 | 
				
			||||||
  return BalanceAssertion
 | 
					  return BalanceAssertion
 | 
				
			||||||
    { baamount = a
 | 
					    { baamount = a
 | 
				
			||||||
 | 
					    , baexact = isJust exact
 | 
				
			||||||
    , baposition = sourcepos
 | 
					    , baposition = sourcepos
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -752,7 +752,7 @@ transactionFromCsvRecord sourcepos rules record = t
 | 
				
			|||||||
        ,posting {paccount=account2, pamount=amount2, ptransaction=Just t}
 | 
					        ,posting {paccount=account2, pamount=amount2, ptransaction=Just t}
 | 
				
			||||||
        ]
 | 
					        ]
 | 
				
			||||||
      }
 | 
					      }
 | 
				
			||||||
    toAssertion (a, b) = BalanceAssertion{
 | 
					    toAssertion (a, b) = assertion{
 | 
				
			||||||
      baamount   = a,
 | 
					      baamount   = a,
 | 
				
			||||||
      baposition = b
 | 
					      baposition = b
 | 
				
			||||||
      }
 | 
					      }
 | 
				
			||||||
 | 
				
			|||||||
@ -730,6 +730,8 @@ tests_JournalReader = tests "JournalReader" [
 | 
				
			|||||||
    ,test "quoted commodity symbol with digits" $ expectParse (postingp Nothing) "  a  1 \"DE123\"\n"
 | 
					    ,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 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" [
 | 
					  ,tests "transactionmodifierp" [
 | 
				
			||||||
 | 
				
			|||||||
@ -308,3 +308,51 @@ hledger -f - stats
 | 
				
			|||||||
>>> /Transactions/
 | 
					>>> /Transactions/
 | 
				
			||||||
>>>2
 | 
					>>>2
 | 
				
			||||||
>>>=0
 | 
					>>>=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
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user