slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: more transaction balancing/assertions/assignments cleanup

Browse Source
This commit is contained in:
Simon Michael 2019-02-18 12:11:07 -08:00
parent 8789a442a8
commit ba850f3871
5 changed files with 273 additions and 264 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

386
hledger-lib/Hledger/Data/Journal.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
@ -78,18 +79,22 @@ where
import Control.Applicative (Const(..))
import Control.Monad
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Reader as R
import Control.Monad.ST
import Data.Array.ST
import Data.Function ((&))
import Data.Functor.Identity (Identity(..))
import qualified Data.HashTable.ST.Cuckoo as H
import Data.List
import Data.List.Extra (groupSort)
import qualified Data.Map as M
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import qualified Data.Semigroup as Sem
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Safe (headMay, headDef)
@ -97,8 +102,6 @@ import Data.Time.Calendar
import Data.Tree
import System.Time (ClockTime(TOD))
import Text.Printf
import qualified Data.Map as M
import qualified Data.Set as S
import Hledger.Utils
import Hledger.Data.Types
@ -567,6 +570,55 @@ journalModifyTransactions j = j{ jtxns = modifyTransactions (jtxnmodifiers j) (j
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True
-- "Transaction balancing" - inferring missing amounts and checking transaction balancedness and balance assertions
-- | Monad used for statefully balancing/amount-inferring/assertion-checking
-- a sequence of transactions.
-- Perhaps can be simplified, or would a different ordering of layers make sense ?
-- If you see a way, let us know.
type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))
-- | The state used while balancing a sequence of transactions.
data BalancingState s = BalancingState {
-- read only
bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles
,bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used
,bsAssrt :: Bool -- ^ whether to check balance assertions
-- mutable
,bsBalances :: H.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty
,bsTransactions :: STArray s Integer Transaction -- ^ the transactions being balanced
}
-- | Access the current balancing state, and possibly modify the mutable bits,
-- lifting through the Except and Reader layers into the Balancing monad.
withB :: (BalancingState s -> ST s a) -> Balancing s a
withB f = ask >>= lift . lift . f
-- | Get an account's running balance so far.
getAmountB :: AccountName -> Balancing s MixedAmount
getAmountB acc = withB $ \BalancingState{bsBalances} -> do
fromMaybe 0 <$> H.lookup bsBalances acc
-- | Add an amount to an account's running balance, and return the new running balance.
addAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addAmountB acc amt = withB $ \BalancingState{bsBalances} -> do
old <- fromMaybe 0 <$> H.lookup bsBalances acc
let new = old + amt
H.insert bsBalances acc new
return new
-- | Set an account's running balance to this amount, and return the difference from the old.
setAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setAmountB acc amt = withB $ \BalancingState{bsBalances} -> do
old <- fromMaybe 0 <$> H.lookup bsBalances acc
H.insert bsBalances acc amt
return $ amt - old
-- | Update (overwrite) this transaction with a new one.
storeTransactionB :: Transaction -> Balancing s ()
storeTransactionB t = withB $ \BalancingState{bsTransactions} ->
void $ writeArray bsTransactions (tindex t) t
-- | Infer any missing amounts (to satisfy balance assignments and
-- to balance transactions) and check that all transactions balance
-- and (optional) all balance assertions pass. Or return an error message
@ -577,171 +629,137 @@ journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTran
-- This does multiple things because amount inferring, balance assignments,
-- balance assertions and posting dates are interdependent.
--
-- Overview, 20190216:
-- This can be simplified further. Overview as of 20190219:
-- @
-- ****** parseAndFinaliseJournal['] [[Cli/Utils.hs]], journalAddForecast [[Common.hs]], budgetJournal [[BudgetReport.hs]], tests [[BalanceReport.hs]]
-- ****** parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (BudgetReport.hs), tests (BalanceReport.hs)
-- ******* journalBalanceTransactions
-- ******** runST
-- ********* runExceptT
-- ********** balanceTransaction (Transaction.hs)
-- *********** balanceTransactionHelper
-- ********** runReaderT
-- *********** balanceNoAssignmentTransactionB
-- ************ balanceTransactionB [[Transaction.hs]]
-- ************* balanceTransactionHelper
-- ************** inferBalancingAmount
-- *********** balanceAssignmentTransactionAndOrCheckAssertionsB
-- ************ addAmountAndCheckBalanceAssertionB
-- ************* addToBalanceB
-- ************ inferFromAssignmentB
-- ************ balanceTransactionB [[Transaction.hs]]
-- ************* balanceTransactionHelper
-- ************ addToBalanceB
-- ****** uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} [[ErrorScreen.hs]]
-- *********** balanceTransactionAndCheckAssertionsB
-- ************ addAmountAndCheckAssertionB
-- ************ addOrAssignAmountAndCheckAssertionB
-- ************ balanceTransactionHelper (Transaction.hs)
-- ****** uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} (ErrorScreen.hs)
-- ******* journalCheckBalanceAssertions
-- ******** journalBalanceTransactions
-- ****** transactionWizard, postingsBalanced [[Add.hs]], tests [[Transaction.hs]]
-- ******* balanceTransaction
-- ****** transactionWizard, postingsBalanced (Add.hs), tests (Transaction.hs)
-- ******* balanceTransaction (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ?
-- @
journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions assrt j' =
let
-- ensure transactions are numbered, so we can store them by number
j@Journal{jtxns=ts} = journalNumberTransactions j'
styles = journalCommodityStyles j
-- display precisions used in balanced checking
styles = Just $ journalCommodityStyles j
-- balance assignments will not be allowed on these
txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j
in
runST $ do
bals <- H.newSized (length $ journalAccountNamesUsed j)
txns <- newListArray (1, genericLength ts) ts
-- We'll update a mutable array of transactions as we balance them,
-- not strictly necessary but avoids a sort at the end I think.
balancedtxns <- newListArray (1, genericLength ts) ts
-- Infer missing posting amounts, check transactions are balanced,
-- and check balance assertions. This is done in two passes:
runExceptT $ do
flip runReaderT (BalancingState styles txnmodifieraccts assrt bals txns) $ do
-- Fill in missing posting amounts, check transactions are balanced,
-- and check balance assertions. This is done in two passes:
-- 1. Balance the transactions which don't have balance assignments,
-- and collect their postings, plus the still-unbalanced transactions, in date order.
sortedpsandts <- sortOn (either postingDate tdate) . concat <$>
mapM' balanceNoAssignmentTransactionB (jtxns j)
-- 2. Step through these, keeping running account balances,
-- performing balance assignments in and balancing the remaining transactions,
-- and checking balance assertions. This last could be a separate pass
-- but perhaps it's more efficient to do all at once.
void $ mapM' balanceAssignmentTransactionAndOrCheckAssertionsB sortedpsandts
ts' <- lift $ getElems txns
-- 1. Balance the transactions which don't have balance assignments.
let (noassignmenttxns, withassignmenttxns) = partition (null . assignmentPostings) ts
noassignmenttxns' <- forM noassignmenttxns $ \t ->
either throwError (\t -> lift (writeArray balancedtxns (tindex t) t) >> return t) $
balanceTransaction styles t
-- 2. Step through the postings of those transactions, and the remaining transactions, in date order,
let sortedpsandts :: [Either Posting Transaction] =
sortOn (either postingDate tdate) $
map Left (concatMap tpostings noassignmenttxns') ++
map Right withassignmenttxns
-- keeping running account balances,
runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j)
flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do
-- performing balance assignments in, and balancing, the remaining transactions,
-- and checking balance assertions as each posting is processed.
void $ mapM' balanceTransactionAndCheckAssertionsB sortedpsandts
ts' <- lift $ getElems balancedtxns
return j{jtxns=ts'}
-- | If this transaction has no balance assignments, balance and store it
-- and return its postings. If it can't be balanced, an error will be thrown.
--
-- It it has balance assignments, return it unchanged. If any posting has both
-- a balance assignment and a custom date, an error will be thrown.
--
balanceNoAssignmentTransactionB :: Transaction -> Balancing s [Either Posting Transaction]
balanceNoAssignmentTransactionB t
| null (assignmentPostings t) = do
styles <- R.reader bsStyles
t' <- lift $ ExceptT $ return $ balanceTransaction (Just styles) t
storeTransactionB t'
return [Left $ removePrices p | p <- tpostings t']
-- | This function is called statefully on each of a date-ordered sequence of
-- 1. fully explicit postings from already-balanced transactions and
-- 2. not-yet-balanced transactions containing balance assignments.
-- It executes balance assignments and finishes balancing the transactions,
-- and checks balance assertions on each posting as it goes.
-- An error will be thrown if a transaction can't be balanced
-- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment).
-- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments.
-- This stores the balanced transactions in case 2 but not in case 1.
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
| otherwise = do
when (any (isJust . pdate) $ tpostings t) $ -- XXX check more carefully that date and assignment are on same posting ?
throwError $
unlines $
[ "postings may not have both a custom date and a balance assignment."
, "Write the posting amount explicitly, or remove the posting date:\n"
, showTransaction t
]
return [Right $ t {tpostings = removePrices <$> tpostings t}]
balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =
-- update the account's running balance and check the balance assertion if any
void $ addAmountAndCheckAssertionB $ removePrices p
-- | This function is called in turn on each item in a date-ordered sequence
-- of postings (from already-balanced transactions) or transactions
-- (not yet balanced, because containing balance assignments).
-- It applies balance assignments and balances the unbalanced transactions,
-- and checks any balance assertion(s).
--
-- For a posting: update the account's running balance, and
-- check the balance assertion if any.
--
-- For a transaction: for each posting,
--
-- - if it has a missing amount and a balance assignment, infer the amount
--
-- - update the account's running balance
--
-- - check the balance assertion if any
--
-- Then balance the transaction, so that any remaining missing amount is inferred.
-- And if that happened, also update *that* account's running balance. XXX and check the assertion ?
-- And store the transaction.
--
-- Will throw an error if a transaction can't be balanced,
-- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment).
--
balanceAssignmentTransactionAndOrCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceAssignmentTransactionAndOrCheckAssertionsB (Left p) = do
checkIllegalBalanceAssignmentB p
void $ addAmountAndCheckBalanceAssertionB return p
balanceAssignmentTransactionAndOrCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
-- make sure we can handle the balance assignments
mapM_ checkIllegalBalanceAssignmentB ps
ps' <- forM ps $ addAmountAndCheckBalanceAssertionB inferFromAssignmentB
-- for each posting, infer its amount from the balance assignment if applicable,
-- update the account's running balance and check the balance assertion if any
ps' <- forM ps $ \p -> pure (removePrices p) >>= addOrAssignAmountAndCheckAssertionB
-- infer any remaining missing amounts, and make sure the transaction is now fully balanced
styles <- R.reader bsStyles
storeTransactionB =<<
balanceTransactionB (fmap void . addToBalanceB) (Just styles) t{tpostings=ps'}
case balanceTransactionHelper styles t{tpostings=ps'} of
Left err -> throwError err
Right (t', inferredacctsandamts) -> do
-- for each amount just inferred, update the running balance
mapM_ (uncurry addAmountB) inferredacctsandamts
-- and save the balanced transaction.
storeTransactionB t'
-- | Throw an error if this posting is trying to do a balance assignment and
-- the account does not allow balance assignments (because it is referenced
-- by a transaction modifier).
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB p = do
unassignable <- R.asks bsUnassignable
when (isAssignment p && paccount p `S.member` unassignable) $
throwError $
unlines $
[ "cannot assign amount to account "
, ""
, " " ++ T.unpack (paccount p)
, ""
, "because it is also included in transaction modifiers."
]
-- | If this posting has an explicit amount, add it to the account's running balance.
-- If it has a missing amount and a balance assignment, infer the amount from, and
-- reset the running balance to, the assigned balance.
-- If it has a missing amount and no balance assignment, leave it for later.
-- Then test the balance assertion if any.
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba}
| hasAmount p = do
newbal <- addAmountB acc amt
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal
return p
| Nothing <- mba = return p
| Just BalanceAssertion{baamount,batotal} <- mba = do
(diff,newbal) <- case batotal of
True -> do
-- a total balance assignment
let newbal = Mixed [baamount]
diff <- setAmountB acc newbal
return (diff,newbal)
False -> do
-- a partial balance assignment
oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getAmountB acc
let assignedbalthiscommodity = Mixed [baamount]
newbal = oldbalothercommodities + assignedbalthiscommodity
diff <- setAmountB acc newbal
return (diff,newbal)
let p' = p{pamount=diff, porigin=Just $ originalPosting p}
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal
return p'
-- | If this posting has a missing amount and a balance assignment, use
-- the running account balance to infer the amount required to satisfy
-- the assignment.
inferFromAssignmentB :: Posting -> Balancing s Posting
inferFromAssignmentB p@Posting{paccount=acc} =
case pbalanceassertion p of
Nothing -> return p
Just ba | batotal ba -> do
diff <- setAccountRunningBalance acc $ Mixed [baamount ba]
return $ setPostingAmount diff p
Just ba -> do
oldbal <- fromMaybe 0 <$> liftB (\bs -> H.lookup (bsBalances bs) acc)
let amt = baamount ba
newbal = filterMixedAmount ((/=acommodity amt).acommodity) oldbal + Mixed [amt]
diff <- setAccountRunningBalance acc newbal
return $ setPostingAmount diff p
where
setPostingAmount a p = p{pamount=a, porigin=Just $ originalPosting p}
-- | Set the account's running balance, and return the difference from the old.
setAccountRunningBalance :: AccountName -> MixedAmount -> Balancing s MixedAmount
setAccountRunningBalance acc amt = liftB $ \BalancingState{bsBalances=bals} -> do
old <- fromMaybe 0 <$> H.lookup bals acc
H.insert bals acc amt
return $ amt - old
-- | Adds a posting's amount to the posting's account's running balance, and
-- checks the posting's balance assertion if any. Or if the posting has no
-- amount, runs the supplied fallback action.
addAmountAndCheckBalanceAssertionB ::
(Posting -> Balancing s Posting) -- ^ fallback action XXX why ?
-> Posting
-> Balancing s Posting
addAmountAndCheckBalanceAssertionB _ p | hasAmount p = do
newAmt <- addToBalanceB (paccount p) (pamount p)
assrt <- R.reader bsAssrt
when assrt $ checkBalanceAssertionB p newAmt
-- | Add the posting's amount to its account's running balance, and
-- optionally check the posting's balance assertion if any.
-- The posting is expected to have an explicit amount (otherwise this does nothing).
-- Adding and checking balance assertions are tightly paired because we
-- need to see the balance as it stands after each individual posting.
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB p | hasAmount p = do
newbal <- addAmountB (paccount p) (pamount p)
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal
return p
addAmountAndCheckBalanceAssertionB fallback p = fallback p
addAmountAndCheckAssertionB p = return p
-- | Check a posting's balance assertion against the given actual balance, and
-- return an error if the assertion is not satisfied.
@ -766,22 +784,21 @@ checkBalanceAssertionB _ _ = return ()
-- subaccount-inclusive balance; otherwise, with the subaccount-exclusive balance.
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt actualbal = do
-- sum the running balances of this account and any subaccounts seen so far
bals <- R.asks bsBalances
actualibal <- liftB $ const $ H.foldM
(\bal (acc, amt) -> return $
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc
then bal + amt
else bal)
0
bals
let isinclusive = maybe False bainclusive $ pbalanceassertion p
actualbal' <-
if isinclusive
then
-- sum the running balances of this account and any of its subaccounts seen so far
withB $ \BalancingState{bsBalances} ->
H.foldM
(\ibal (acc, amt) -> return $ ibal +
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)
0
bsBalances
else return actualbal
let
isinclusive = maybe False bainclusive $ pbalanceassertion p
actualbal'
| isinclusive = actualibal
| otherwise = actualbal
assertedcomm = acommodity assertedamt
actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm actualbal'
actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm $ actualbal'
pass =
aquantity
-- traceWith (("asserted:"++).showAmountDebug)
@ -823,6 +840,47 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
when (not pass) $ throwError errmsg
-- | Throw an error if this posting is trying to do an illegal balance assignment.
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB p = do
checkBalanceAssignmentPostingDateB p
checkBalanceAssignmentUnassignableAccountB p
-- XXX these should show position. annotateErrorWithTransaction t ?
-- | Throw an error if this posting is trying to do a balance assignment and
-- has a custom posting date (which makes amount inference too hard/impossible).
checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB p =
when (hasBalanceAssignment p && isJust (pdate p)) $
throwError $ unlines $
["postings which are balance assignments may not have a custom date."
,"Please write the posting amount explicitly, or remove the posting date:"
,""
,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p
]
-- | Throw an error if this posting is trying to do a balance assignment and
-- the account does not allow balance assignments (eg because it is referenced
-- by a transaction modifier, which might generate additional postings to it).
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB p = do
unassignable <- R.asks bsUnassignable
when (hasBalanceAssignment p && paccount p `S.member` unassignable) $
throwError $ unlines $
["balance assignments cannot be used with accounts which are"
,"posted to by transaction modifier rules (auto postings)."
,"Please write the posting amount explicitly, or remove the rule."
,""
,"account: "++T.unpack (paccount p)
,""
,"transaction:"
,""
,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p
]
--
-- | Choose and apply a consistent display format to the posting
-- amounts in each commodity. Each commodity's format is specified by
-- a commodity format directive, or otherwise inferred from posting
@ -1190,4 +1248,24 @@ tests_Journal = tests "Journal" [
,test "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
]
,test "journalBalanceTransactions" $ do
let ej = journalBalanceTransactions True $
nulljournal{ jtxns = [
txnTieKnot $ nulltransaction{
tdate=parsedate "2019/01/01",
tpostings=[
nullposting{
ptype=VirtualPosting
,paccount="a"
,pamount=missingmixedamt
,pbalanceassertion=Just nullassertion{baamount=num 1}
}
],
tprecedingcomment=""
}
]
}
expectRight ej
let Right j = ej
(jtxns j & head & tpostings & head & pamount) `is` Mixed [num 1]
]

6
hledger-lib/Hledger/Data/Posting.hs
View File

@ -25,7 +25,7 @@ module Hledger.Data.Posting (
isVirtual,
isBalancedVirtual,
isEmptyPosting,
isAssignment,
hasBalanceAssignment,
hasAmount,
postingAllTags,
transactionAllTags,
@ -144,8 +144,8 @@ isBalancedVirtual p = ptype p == BalancedVirtualPosting
hasAmount :: Posting -> Bool
hasAmount = (/= missingmixedamt) . pamount
isAssignment :: Posting -> Bool
isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p)
hasBalanceAssignment :: Posting -> Bool
hasBalanceAssignment p = not (hasAmount p) && isJust (pbalanceassertion p)
-- | Sorted unique account names referenced by these postings.
accountNamesFromPostings :: [Posting] -> [AccountName]

98
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -28,12 +28,7 @@ module Hledger.Data.Transaction (
transactionsPostings,
isTransactionBalanced,
balanceTransaction,
Balancing,
BalancingState(..),
addToBalanceB,
storeTransactionB,
liftB,
balanceTransactionB,
balanceTransactionHelper,
-- nonzerobalanceerror,
-- * date operations
transactionDate2,
@ -49,18 +44,12 @@ module Hledger.Data.Transaction (
sourceFilePath,
sourceFirstLine,
showGenericSourcePos,
annotateErrorWithTransaction,
-- * tests
tests_Transaction
)
where
import Data.List
import Control.Monad.Except
import Control.Monad.Reader (ReaderT, ask)
import Control.Monad.ST
import Data.Array.ST
import qualified Data.HashTable.ST.Cuckoo as HT
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
@ -308,7 +297,7 @@ realPostings :: Transaction -> [Posting]
realPostings = filter isReal . tpostings
assignmentPostings :: Transaction -> [Posting]
assignmentPostings = filter isAssignment . tpostings
assignmentPostings = filter hasBalanceAssignment . tpostings
virtualPostings :: Transaction -> [Posting]
virtualPostings = filter isVirtual . tpostings
@ -341,69 +330,28 @@ isTransactionBalanced styles t =
bvsum' = canonicalise $ costOfMixedAmount bvsum
canonicalise = maybe id canonicaliseMixedAmount styles
-- | Monad used for statefully "balancing" a sequence of transactions.
type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))
-- | The state used while balancing a sequence of transactions.
data BalancingState s = BalancingState {
-- read only
bsStyles :: M.Map CommoditySymbol AmountStyle -- ^ commodity display styles
,bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used
,bsAssrt :: Bool -- ^ whether to check balance assertions
-- mutable
,bsBalances :: HT.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty
,bsTransactions :: STArray s Integer Transaction -- ^ the transactions being balanced
}
-- | Lift a BalancingState mutator through the Except and Reader
-- layers into the Balancing monad.
liftB :: (BalancingState s -> ST s a) -> Balancing s a
liftB f = ask >>= lift . lift . f
-- | Add this amount to this account's running balance,
-- and return the new running balance.
addToBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToBalanceB acc amt = liftB $ \BalancingState{bsBalances=bals} -> do
b <- maybe amt (+amt) <$> HT.lookup bals acc
HT.insert bals acc b
return b
-- | Update (overwrite) this transaction with a new one.
storeTransactionB :: Transaction -> Balancing s ()
storeTransactionB t = liftB $ \bs ->
void $ writeArray (bsTransactions bs) (tindex t) t
-- | Balance this transaction, ensuring that its postings sum to 0,
-- | Balance this transaction, ensuring that its postings
-- (and its balanced virtual postings) sum to 0,
-- by inferring a missing amount or conversion price(s) if needed.
-- Or if balancing is not possible, because of unbalanced amounts or
-- 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,
-- so those can optionally be provided.
-- Or if balancing is not possible, because the amounts don't sum to 0 or
-- because there's more than one missing amount, return an error message.
--
-- Transactions with balance assignments can have more than one
-- missing amount; to balance those you should use the more powerful
-- journalBalanceTransactions.
--
-- The "sum to 0" test is done using commodity display precisions,
-- if provided, so that the result agrees with the numbers users can see.
--
balanceTransaction ::
Maybe (Map.Map CommoditySymbol AmountStyle) -- ^ commodity display styles
-> Transaction
-> Either String Transaction
balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles
-- | Like balanceTransaction, but when inferring amounts it will also
-- use the given state update function to update running account balances.
-- Used when balancing a sequence of transactions (see journalBalanceTransactions).
balanceTransactionB ::
(AccountName -> MixedAmount -> Balancing s ()) -- ^ function to update running balances
-> Maybe (Map.Map CommoditySymbol AmountStyle) -- ^ commodity display styles
-> Transaction
-> Balancing s Transaction
balanceTransactionB updatebalsfn mstyles t = do
case balanceTransactionHelper mstyles t of
Left err -> throwError err
Right (t', inferredacctsandamts) -> do
mapM_ (uncurry updatebalsfn) inferredacctsandamts
return t'
-- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB;
-- use one of those instead. It also returns a list of accounts
-- and amounts that were inferred.
balanceTransactionHelper ::
Maybe (Map.Map CommoditySymbol AmountStyle) -- ^ commodity display styles
-> Transaction
@ -413,7 +361,7 @@ balanceTransactionHelper mstyles t = do
inferBalancingAmount (fromMaybe Map.empty mstyles) $ inferBalancingPrices t
if isTransactionBalanced mstyles t'
then Right (txnTieKnot t', inferredamtsandaccts)
else Left $ annotateErrorWithTxn t' $ nonzerobalanceerror t'
else Left $ annotateErrorWithTransaction t' $ nonzerobalanceerror t'
where
nonzerobalanceerror :: Transaction -> String
@ -428,8 +376,8 @@ balanceTransactionHelper mstyles t = do
++ showMixedAmount (costOfMixedAmount bvsum)
sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String
annotateErrorWithTxn :: Transaction -> String -> String
annotateErrorWithTxn t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransactionUnelided t]
annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransactionUnelided t]
-- | Infer up to one missing amount for this transactions's real postings, and
-- likewise for its balanced virtual postings, if needed; or return an error
@ -445,9 +393,9 @@ inferBalancingAmount ::
-> Either String (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount styles t@Transaction{tpostings=ps}
| length amountlessrealps > 1
= Left $ annotateErrorWithTxn t "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"
= Left $ annotateErrorWithTransaction t "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"
| length amountlessbvps > 1
= Left $ annotateErrorWithTxn t "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"
= Left $ annotateErrorWithTransaction t "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"
| otherwise
= let psandinferredamts = map inferamount ps
inferredacctsandamts = [(paccount p, amt) | (p, Just amt) <- psandinferredamts]

2
tests/journal/auto-postings.test
View File

@ -162,7 +162,7 @@ $ hledger -f- print --auto -x
# 9.
$ hledger print -f- --auto
>2 /cannot assign amount to account/
>2 /cannot be used with accounts which are/
>=1

45
tests/journal/balance-assertions.test
View File

@ -231,27 +231,10 @@ hledger -f - stats
a $1 =$1
b =$-1 ; date:2012/1/1
>>>2 /postings may not have both a custom date and a balance assignment/
>>>2 /balance assignments may not have a custom date/
>>>=1
# 13. Having both assignments and posting dates is not supported.
hledger -f - stats
<<<
2013/1/1
a 1 = -2
b
c = 5
2014/1/1
a -3 = -3 ; date:2012/1/1
d = 3
>>>2 /postings may not have both a custom date and a balance assignment/
>>>=1
# 14. Posting Date
# 13. Posting Date
hledger -f - stats
<<<
@ -276,7 +259,7 @@ hledger -f - stats
>>>2
>>>=0
# 15. Mix different commodities
# 14. Mix different commodities
hledger -f - stats
<<<
2016/1/1
@ -290,7 +273,7 @@ hledger -f - stats
>>>2
>>>=0
# 16. Mix different commodities and assignments
# 15. Mix different commodities and assignments
hledger -f - stats
<<<
2016/1/1
@ -311,7 +294,7 @@ hledger -f - stats
>>>2
>>>=0
# 17. Total assertions (==) parse correctly
# 16. Total assertions (==) parse correctly
hledger -f - stats
<<<
2016/1/1
@ -324,7 +307,7 @@ hledger -f - stats
>>>2
>>>=0
# 18. Total assertions consider entire multicommodity amount
# 17. Total assertions consider entire multicommodity amount
hledger -f - stats
<<<
2016/1/1
@ -340,7 +323,7 @@ hledger -f - stats
>>>2 /balance assertion.*line 10, column 15/
>>>=1
# 19. Mix different commodities and total assignments
# 18. Mix different commodities and total assignments
hledger -f - stats
<<<
2016/1/1
@ -359,7 +342,7 @@ hledger -f - stats
>>>2
>>>=0
# 20. Balance assertions may have a price, but it's ignored
# 19. Balance assertions may have a price, but it's ignored
hledger -f- print
<<<
2019/01/01
@ -370,7 +353,7 @@ hledger -f- print
>>>=0
# 21. Balance assignments may have a price, and it's used for the posting amount.
# 20. Balance assignments may have a price, and it's used for the posting amount.
# But not shown as part of the balance assertion in the resulting posting.
hledger -f- print --explicit
<<<
@ -382,7 +365,7 @@ hledger -f- print --explicit
>>>=0
# 22. close generates balance assertions without prices
# 21. close generates balance assertions without prices
hledger -f- close -e 2019/1/2
<<<
2019/01/01
@ -398,7 +381,7 @@ hledger -f- close -e 2019/1/2
>>>=0
# 23. The exact amounts are compared; display precision does not affect assertions.
# 22. The exact amounts are compared; display precision does not affect assertions.
hledger -f- print
<<<
commodity $1000.00
@ -413,7 +396,7 @@ commodity $1000.00
>>>2
>>>=0
# 24. This fails
# 23. This fails
hledger -f- print
<<<
commodity $1000.00
@ -427,7 +410,7 @@ commodity $1000.00
>>>2 /difference: 0\.004/
>>>=1
# 25. This fails
# 24. This fails
hledger -f- print
<<<
commodity $1000.00
@ -441,7 +424,7 @@ commodity $1000.00
>>>2 /difference: 0\.0001/
>>>=1
# 26. Inclusive assertions include balances from subaccounts.
# 25. Inclusive assertions include balances from subaccounts.
hledger -f- print
<<<
2019/1/1