From 45401e538e18c1845387209db85fe37d8c165d28 Mon Sep 17 00:00:00 2001 From: Johannes Gerer Date: Sat, 10 Dec 2016 16:04:48 +0100 Subject: [PATCH] Balance Assignments and accounts resetting (#438) * Changed behavior of `readJournalFiles` to be identical to `readJournalFile` for singleton lists * Balance Assertions have to be simple Amounts * Add 'isAssignment' and 'assignmentPostings' to Hledger.Data.Posting and Transaction * Implemented 'balanceTransactionUpdate', a more general version of 'balanceTransaction' that takes an update function * Fixed test cases. * Implemented balance assignment ("resetting a balance") * Add assertions to show function * updated the comments * numbering is not needed in journalCheckBalanceAssertions * remove prices before balance checks * rename functions --- hledger-lib/Hledger/Data/Amount.hs | 3 + hledger-lib/Hledger/Data/Journal.hs | 288 +++++++++++++------ hledger-lib/Hledger/Data/Posting.hs | 10 + hledger-lib/Hledger/Data/Transaction.hs | 115 +++++--- hledger-lib/Hledger/Data/Types.hs | 2 +- hledger-lib/Hledger/Read/Common.hs | 4 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 2 +- hledger-lib/hledger-lib.cabal | 3 + hledger-lib/package.yaml | 1 + tests/cli/multiple-files.test | 3 +- tests/i18n/wide-char-layout.test | 4 + tests/journal/balance-assertions.test | 172 +++++++++++ tests/journal/virtual-postings.test | 1 + 13 files changed, 478 insertions(+), 130 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 4f6c3c3c1..24158290b 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -82,7 +82,10 @@ module Hledger.Data.Amount ( costOfMixedAmount, divideMixedAmount, averageMixedAmounts, + isNegativeAmount, isNegativeMixedAmount, + isZeroAmount, + isReallyZeroAmount, isZeroMixedAmount, isReallyZeroMixedAmount, isReallyZeroMixedAmountCost, diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index fb4a213b1..acfc96cdd 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Rank2Types #-} {-# LANGUAGE StandaloneDeriving, OverloadedStrings #-} {-| @@ -61,7 +62,13 @@ module Hledger.Data.Journal ( tests_Hledger_Data_Journal, ) where +import Control.Arrow import Control.Monad +import Control.Monad.Except +import qualified Control.Monad.Reader as R +import Control.Monad.ST +import Data.Array.ST +import qualified Data.HashTable.ST.Cuckoo as HT import Data.List -- import Data.Map (findWithDefault) import Data.Maybe @@ -463,8 +470,8 @@ journalApplyAliases aliases j@Journal{jtxns=ts} = -- check balance assertions. journalFinalise :: ClockTime -> FilePath -> Text -> Bool -> ParsedJournal -> Either String Journal journalFinalise t path txt assrt j@Journal{jfiles=fs} = do - (journalNumberAndTieTransactions <$> - (journalBalanceTransactions $ + (journalTieTransactions <$> + (journalBalanceTransactions assrt $ journalApplyCommodityStyles $ j{ jfiles = (path,txt) : reverse fs , jlastreadtime = t @@ -473,7 +480,6 @@ journalFinalise t path txt assrt j@Journal{jfiles=fs} = do , jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction , jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice })) - >>= if assrt then journalCheckBalanceAssertions else return journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions @@ -494,94 +500,208 @@ journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ -- | Check any balance assertions in the journal and return an error -- message if any of them fail. journalCheckBalanceAssertions :: Journal -> Either String Journal -journalCheckBalanceAssertions j = do - let postingsByAccount = groupBy (\p1 p2 -> paccount p1 == paccount p2) $ - sortBy (comparing paccount) $ - journalPostings j - forM_ postingsByAccount checkBalanceAssertionsForAccount - Right j +journalCheckBalanceAssertions j = + runST $ journalBalanceTransactionsST True j + (return ()) (\_ _ -> return ()) (const $ return j) -- noops --- Check any balance assertions in this sequence of postings to a single account. -checkBalanceAssertionsForAccount :: [Posting] -> Either String () -checkBalanceAssertionsForAccount ps - | null errs = Right () - | otherwise = Left $ head errs - where - errs = fst $ - foldl' checkBalanceAssertion ([],nullmixedamt) $ - splitAssertions $ - sortBy (comparing postingDate) ps --- Given a starting balance, accumulated errors, and a non-null sequence of --- postings to a single account with a balance assertion in the last: --- check that the final balance matches the balance assertion. --- If it does, return the new balance, otherwise add an error to the --- error list. Intended to be called from a fold. -checkBalanceAssertion :: ([String],MixedAmount) -> [Posting] -> ([String],MixedAmount) -checkBalanceAssertion (errs,startbal) ps - | null ps = (errs,startbal) - | isNothing $ pbalanceassertion p = (errs,startbal) - | iswrong = (errs++[err], finalfullbal) - | otherwise = (errs,finalfullbal) - where - p = last ps - Just assertedbal = pbalanceassertion p - assertedcomm = maybe "" acommodity $ headMay $ amounts assertedbal - finalfullbal = sum $ [startbal] ++ map pamount (dbg2 "ps" ps) - finalsinglebal = filterMixedAmount (\a -> acommodity a == assertedcomm) finalfullbal - actualbal = finalsinglebal -- just check the single-commodity balance, like Ledger; maybe add ==FULLBAL later - iswrong = dbg2 debugmsg $ - not (isReallyZeroMixedAmount (actualbal - assertedbal)) - -- bal' /= assertedbal -- MixedAmount's Eq instance currently gets confused by different precisions - where - debugmsg = "assertions: on " ++ show (postingDate p) ++ " balance of " ++ show assertedcomm - ++ " in " ++ T.unpack (paccount p) ++ " should be " ++ show assertedbal - diff = assertedbal - actualbal - diffplus | isNegativeMixedAmount diff == Just False = "+" - | otherwise = "" - err = printf (unlines [ - "balance assertion error%s", - "after posting:", - "%s", - "balance assertion details:", - "date: %s", - "account: %s", - "commodity: %s", - "calculated: %s", - "asserted: %s (difference: %s)" - ]) - (case ptransaction p of - Nothing -> ":" -- shouldn't happen - Just t -> printf " in \"%s\" (line %d, column %d):\nin transaction:\n%s" f l c (chomp $ show t) :: String - where GenericSourcePos f l c = tsourcepos t) - (showPostingLine p) - (showDate $ postingDate p) - (T.unpack $ paccount p) -- XXX pack - assertedcomm - (showMixedAmount finalsinglebal) - (showMixedAmount assertedbal) - (diffplus ++ showMixedAmount diff) +-- | Check a posting's balance assertion and return an error if it +-- fails. +checkBalanceAssertion :: Posting -> MixedAmount -> Either String () +checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass} amt + | isReallyZeroAmount diff = Right () + | True = Left err + where assertedcomm = acommodity ass + actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts amt) + diff = ass - actualbal + diffplus | isNegativeAmount diff == False = "+" + | otherwise = "" + err = printf (unlines + [ "balance assertion error%s", + "after posting:", + "%s", + "balance assertion details:", + "date: %s", + "account: %s", + "commodity: %s", + "calculated: %s", + "asserted: %s (difference: %s)" + ]) + (case ptransaction p of + Nothing -> ":" -- shouldn't happen + Just t -> printf " in \"%s\" (line %d, column %d):\nin transaction:\n%s" + f l c (chomp $ show t) :: String + where GenericSourcePos f l c = tsourcepos t) + (showPostingLine p) + (showDate $ postingDate p) + (T.unpack $ paccount p) -- XXX pack + assertedcomm + (showAmount actualbal) + (showAmount ass) + (diffplus ++ showAmount diff) +checkBalanceAssertion _ _ = Right () --- Given a sequence of postings to a single account, split it into --- sub-sequences consisting of ordinary postings followed by a single --- balance-asserting posting. Postings not followed by a balance --- assertion are discarded. -splitAssertions :: [Posting] -> [[Posting]] -splitAssertions ps - | null rest = [] - | otherwise = (ps'++[head rest]):splitAssertions (tail rest) - where - (ps',rest) = break (isJust . pbalanceassertion) ps +-- | Environment for 'CurrentBalancesModifier' +data Env s = Env { eBalances :: HT.HashTable s AccountName MixedAmount + , eStoreTx :: Transaction -> ST s () + , eAssrt :: Bool + , eStyles :: Maybe (M.Map CommoditySymbol AmountStyle) } + +-- | Monad transformer stack with a reference to a mutable hashtable +-- of current account balances and a mutable array of finished +-- transactions in original parsing order. +type CurrentBalancesModifier s = R.ReaderT (Env s) (ExceptT String (ST s)) -- | Fill in any missing amounts and check that all journal transactions -- balance, or return an error message. This is done after parsing all -- amounts and applying canonical commodity styles, since balancing -- depends on display precision. Reports only the first error encountered. -journalBalanceTransactions :: Journal -> Either String Journal -journalBalanceTransactions j@Journal{jtxns=ts, jinferredcommodities=ss} = - case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'} - Left e -> Left e - where balance = balanceTransaction (Just ss) +journalBalanceTransactions :: Bool -> Journal -> Either String Journal +journalBalanceTransactions assrt j = + runST $ journalBalanceTransactionsST assrt (journalNumberTransactions j) + (newArray_ (1, genericLength $ jtxns j) + :: forall s. ST s (STArray s Integer Transaction)) + (\arr tx -> writeArray arr (tindex tx) tx) + $ fmap (\txns -> j{ jtxns = txns}) . getElems + + +-- | Generalization used in the definition of +-- 'journalBalanceTransactionsST and 'journalCheckBalanceAssertions' +journalBalanceTransactionsST :: + Bool + -> Journal + -> ST s txns + -- ^ creates transaction store + -> (txns -> Transaction -> ST s ()) + -- ^ "store" operation + -> (txns -> ST s a) + -- ^ calculate result from transactions + -> ST s (Either String a) +journalBalanceTransactionsST assrt j createStore storeIn extract = + runExceptT $ do + bals <- lift $ HT.newSized size + txStore <- lift $ createStore + flip R.runReaderT (Env bals (storeIn txStore) assrt $ + Just $ jinferredcommodities j) $ do + dated <- fmap snd . sortBy (comparing fst) . concat + <$> mapM discriminateByDate (jtxns j) + mapM checkInferAndRegisterAmounts dated + lift $ extract txStore + where size = genericLength $ journalPostings j + +-- | This converts a transaction into a list of objects whose dates +-- have to be considered when checking balance assertions and handled +-- by 'checkInferAndRegisterAmounts'. +-- +-- Transaction without balance assignments can be balanced and stored +-- immediately and their (possibly) dated postings are returned. +-- +-- Transaction with balance assignments are only supported if no +-- posting has a 'pdate' value. Supported transactions will be +-- returned unchanged and balanced and stored later in 'checkInferAndRegisterAmounts'. +discriminateByDate :: Transaction + -> CurrentBalancesModifier s [(Day, Either Posting Transaction)] +discriminateByDate tx + | null (assignmentPostings tx) = do + styles <- R.reader $ eStyles + balanced <- lift $ ExceptT $ return + $ balanceTransaction styles tx + storeTransaction balanced + return $ fmap (postingDate &&& (Left . removePrices)) + $ tpostings $ balanced + | True = do + when (any (isJust . pdate) $ tpostings tx) $ + throwError $ unlines $ + ["Not supported: Transactions with balance assignments " + ,"AND dated postings without amount:\n" + , showTransaction tx] + return [(tdate tx, Right + $ tx { tpostings = removePrices <$> tpostings tx })] + +-- | This function takes different objects describing changes to +-- account balances on a single day. It can handle either a single +-- posting (from an already balanced transaction without assigments) +-- or a whole transaction with assignments (which is required to no +-- posting with pdate set.). +-- +-- For a single posting, there is not much to do. Only add its amount +-- to its account and check the assertion, if there is one. This +-- functionality is provided by 'addAmountAndCheckBalance'. +-- +-- For a whole transaction, it loops over all postings, and performs +-- 'addAmountAndCheckBalance', if there is an amount. If there is no +-- amount, the amount is inferred by the assertion or left empty if +-- there is no assertion. Then, the transaction is balanced, the +-- inferred amount added to the balance (all in +-- 'balanceTransactionUpdate') and the resulting transaction with no +-- missing amounts is stored in the array, for later retrieval. +-- +-- Again in short: +-- +-- 'Left Posting': Check the balance assertion and update the +-- account balance. If the amount is empty do nothing. this can be +-- the case e.g. for virtual postings +-- +-- 'Right Transaction': Loop over all postings, infer their amounts +-- and then balance and store the transaction. +checkInferAndRegisterAmounts :: Either Posting Transaction + -> CurrentBalancesModifier s () +checkInferAndRegisterAmounts (Left p) = + void $ addAmountAndCheckBalance return p +checkInferAndRegisterAmounts (Right oldTx) = do + let ps = tpostings oldTx + styles <- R.reader $ eStyles + newPostings <- forM ps $ addAmountAndCheckBalance inferFromAssignment + storeTransaction =<< balanceTransactionUpdate + (fmap void . addToBalance) styles oldTx { tpostings = newPostings } + where + inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting + inferFromAssignment p = maybe (return p) + (fmap (\a -> p { pamount = a }) . setBalance (paccount p)) + $ pbalanceassertion p + +-- | Adds a posting's amonut to the posting's account balance and +-- checks a possible balance assertion. If there is no amount, it runs +-- the supplied fallback action. +addAmountAndCheckBalance :: (Posting -> CurrentBalancesModifier s Posting) + -- ^ action to execute, if posting has no amount + -> Posting + -> CurrentBalancesModifier s Posting +addAmountAndCheckBalance _ p | hasAmount p = do + newAmt <- addToBalance (paccount p) $ pamount p + assrt <- R.reader eAssrt + lift $ when assrt $ ExceptT $ return + $ checkBalanceAssertion p newAmt + return p +addAmountAndCheckBalance fallback p = fallback p + +-- | Sets an account's balance to a given amount and returns the +-- difference of new and old amount +setBalance :: AccountName -> Amount -> CurrentBalancesModifier s MixedAmount +setBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do + old <- HT.lookup bals acc + let new = Mixed $ (amt :) $ maybe [] + (filter ((/= acommodity amt) . acommodity) . amounts) old + HT.insert bals acc new + return $ maybe new (new -) old + +-- | Adds an amount to an account's balance and returns the resulting +-- balance +addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount +addToBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do + new <- maybe amt (+ amt) <$> HT.lookup bals acc + HT.insert bals acc new + return new + +-- | Stores a transaction in the transaction array in original parsing +-- order. +storeTransaction :: Transaction -> CurrentBalancesModifier s () +storeTransaction tx = liftModifier $ ($tx) . eStoreTx + +-- | Helper function +liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a +liftModifier f = R.ask >>= lift . lift . f + -- | Choose and apply a consistent display format to the posting -- amounts in each commodity. Each commodity's format is specified by @@ -792,7 +912,7 @@ abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat -- liabilities:debts $1 -- assets:bank:checking -- -Right samplejournal = journalBalanceTransactions $ +Right samplejournal = journalBalanceTransactions False $ nulljournal {jtxns = [ txnTieKnot $ Transaction { diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 86eef78ef..18b6d9d8f 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -20,10 +20,12 @@ module Hledger.Data.Posting ( isVirtual, isBalancedVirtual, isEmptyPosting, + isAssignment, hasAmount, postingAllTags, transactionAllTags, relatedPostings, + removePrices, -- * date operations postingDate, postingDate2, @@ -117,12 +119,20 @@ isBalancedVirtual p = ptype p == BalancedVirtualPosting hasAmount :: Posting -> Bool hasAmount = (/= missingmixedamt) . pamount +isAssignment :: Posting -> Bool +isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) + accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . map paccount sumPostings :: [Posting] -> MixedAmount sumPostings = sum . map pamount +-- | Remove all prices of a posting +removePrices :: Posting -> Posting +removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } + where remove a = a { aprice = NoPrice } + -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if -- there is no parent transaction. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ca7275082..2fedaa627 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-| A 'Transaction' represents a movement of some commodity(ies) between two @@ -19,6 +20,7 @@ module Hledger.Data.Transaction ( showAccountName, hasRealPostings, realPostings, + assignmentPostings, virtualPostings, balancedVirtualPostings, transactionsPostings, @@ -29,6 +31,7 @@ module Hledger.Data.Transaction ( -- * arithmetic transactionPostingBalances, balanceTransaction, + balanceTransactionUpdate, -- * rendering showTransaction, showTransactionUnelided, @@ -39,6 +42,8 @@ module Hledger.Data.Transaction ( ) where import Data.List +import Control.Monad.Except +import Control.Monad.Identity import Data.Maybe import Data.Text (Text) import qualified Data.Text as T @@ -185,8 +190,8 @@ postingAsLines elideamount onelineamounts ps p = postinglines ++ newlinecomments where - postinglines = map rstrip $ lines $ concatTopPadded [account, " ", amount, samelinecomment] - + postinglines = map rstrip $ lines $ concatTopPadded [account, " ", amount, assertion, samelinecomment] + assertion = maybe "" ((" = " ++) . showAmount) $ pbalanceassertion p account = indent $ showstatus p ++ fitString (Just acctwidth) Nothing False True (showAccountName Nothing (ptype p) (paccount p)) @@ -260,6 +265,9 @@ hasRealPostings = not . null . realPostings realPostings :: Transaction -> [Posting] realPostings = filter isReal . tpostings +assignmentPostings :: Transaction -> [Posting] +assignmentPostings = filter isAssignment . tpostings + virtualPostings :: Transaction -> [Posting] virtualPostings = filter isVirtual . tpostings @@ -292,25 +300,41 @@ isTransactionBalanced styles t = -- amount or conversion price(s), or return an error message. -- Balancing is affected by commodity display precisions, so those can -- (optionally) be provided. -balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle) -> Transaction -> Either String Transaction -balanceTransaction styles t = - case inferBalancingAmount t of - Left err -> Left err - Right t' -> let t'' = inferBalancingPrices t' - in if isTransactionBalanced styles t'' - then Right $ txnTieKnot t'' - else Left $ printerr $ nonzerobalanceerror t'' - where - printerr s = intercalate "\n" [s, showTransactionUnelided t] - nonzerobalanceerror :: Transaction -> String - nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg - where - (rsum, _, bvsum) = transactionPostingBalances t - rmsg | isReallyZeroMixedAmountCost rsum = "" - | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum) - bvmsg | isReallyZeroMixedAmountCost bvsum = "" - | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum) - sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String +-- +-- this fails for example, if there are several missing amounts +-- (possibly with balance assignments) +balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle) + -> Transaction -> Either String Transaction +balanceTransaction stylemap = runIdentity . runExceptT + . balanceTransactionUpdate (\_ _ -> return ()) stylemap + + +-- | More general version of 'balanceTransaction' that takes an update +-- function +balanceTransactionUpdate :: MonadError String m + => (AccountName -> MixedAmount -> m ()) + -- ^ update function + -> Maybe (Map.Map CommoditySymbol AmountStyle) + -> Transaction -> m Transaction +balanceTransactionUpdate update styles t = + finalize =<< inferBalancingAmount update t + where + finalize t' = let t'' = inferBalancingPrices t' + in if isTransactionBalanced styles t'' + then return $ txnTieKnot t'' + else throwError $ printerr $ nonzerobalanceerror t'' + printerr s = intercalate "\n" [s, showTransactionUnelided t] + nonzerobalanceerror :: Transaction -> String + nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg + where + (rsum, _, bvsum) = transactionPostingBalances t + rmsg | isReallyZeroMixedAmountCost rsum = "" + | otherwise = "real postings are off by " + ++ showMixedAmount (costOfMixedAmount rsum) + bvmsg | isReallyZeroMixedAmountCost bvsum = "" + | otherwise = "balanced virtual postings are off by " + ++ showMixedAmount (costOfMixedAmount bvsum) + sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String -- | 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 @@ -319,61 +343,70 @@ balanceTransaction styles t = -- We can infer a missing amount when there are multiple postings and exactly -- one of them is amountless. If the amounts had price(s) the inferred amount -- have the same price(s), and will be converted to the price commodity. --- -inferBalancingAmount :: Transaction -> Either String Transaction -inferBalancingAmount t@Transaction{tpostings=ps} +inferBalancingAmount :: MonadError String m + => (AccountName -> MixedAmount -> m ()) + -- ^ update function + -> Transaction -> m Transaction +inferBalancingAmount update t@Transaction{tpostings=ps} | length amountlessrealps > 1 - = Left $ printerr "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)" + = throwError $ printerr "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 $ printerr "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)" + = throwError $ printerr "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 - = Right t{tpostings=map inferamount ps} + = do postings <- mapM inferamount ps + return t{tpostings=postings} where printerr s = intercalate "\n" [s, showTransactionUnelided t] - ((amountfulrealps, amountlessrealps), realsum) = (partition hasAmount (realPostings t), sum $ map pamount amountfulrealps) - ((amountfulbvps, amountlessbvps), bvsum) = (partition hasAmount (balancedVirtualPostings t), sum $ map pamount amountfulbvps) - inferamount p@Posting{ptype=RegularPosting} | not (hasAmount p) = p{pamount=costOfMixedAmount (-realsum)} - inferamount p@Posting{ptype=BalancedVirtualPosting} | not (hasAmount p) = p{pamount=costOfMixedAmount (-bvsum)} - inferamount p = p + ((amountfulrealps, amountlessrealps), realsum) = + (partition hasAmount (realPostings t), sum $ map pamount amountfulrealps) + ((amountfulbvps, amountlessbvps), bvsum) = + (partition hasAmount (balancedVirtualPostings t), sum $ map pamount amountfulbvps) + inferamount p@Posting{ptype=RegularPosting} + | not (hasAmount p) = updateAmount p realsum + inferamount p@Posting{ptype=BalancedVirtualPosting} + | not (hasAmount p) = updateAmount p bvsum + inferamount p = return p + updateAmount p amt = update (paccount p) amt' >> return p { pamount=amt' } + where amt' = costOfMixedAmount (-amt) -- | Infer prices for this transaction's posting amounts, if needed to make -- the postings balance, and if possible. This is done once for the real -- postings and again (separately) for the balanced virtual postings. When -- it's not possible, the transaction is left unchanged. --- +-- -- The simplest example is a transaction with two postings, each in a -- different commodity, with no prices specified. In this case we'll add a -- price to the first posting such that it can be converted to the commodity -- of the second posting (with -B), and such that the postings balance. --- +-- -- In general, we can infer a conversion price when the sum of posting amounts -- contains exactly two different commodities and no explicit prices. Also -- all postings are expected to contain an explicit amount (no missing -- amounts) in a single commodity. Otherwise no price inferring is attempted. --- +-- -- The transaction itself could contain more than two commodities, and/or -- prices, if they cancel out; what matters is that the sum of posting amounts -- contains exactly two commodities and zero prices. --- +-- -- There can also be more than two postings in either of the commodities. --- +-- -- We want to avoid excessive display of digits when the calculated price is -- an irrational number, while hopefully also ensuring the displayed numbers -- make sense if the user does a manual calculation. This is (mostly) achieved -- in two ways: --- +-- -- - when there is only one posting in the "from" commodity, a total price -- (@@) is used, and all available decimal digits are shown --- +-- -- - otherwise, a suitable averaged unit price (@) is applied to the relevant -- postings, with display precision equal to the summed display precisions -- of the two commodities being converted between, or 2, whichever is larger. --- +-- -- (We don't always calculate a good-looking display precision for unit prices -- when the commodity display precisions are low, eg when a journal doesn't -- use any decimal places. The minimum of 2 helps make the prices shown by the -- print command a bit less surprising in this case. Could do better.) --- +-- inferBalancingPrices :: Transaction -> Transaction inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'} where diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 109c6af3c..8faa7bb11 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -198,7 +198,7 @@ data Posting = Posting { pcomment :: Text, -- ^ this posting's comment lines, as a single non-indented multi-line string ptype :: PostingType, ptags :: [Tag], -- ^ tag names and values, extracted from the comment - pbalanceassertion :: Maybe MixedAmount, -- ^ optional: the expected balance in the account after this posting + pbalanceassertion :: Maybe Amount, -- ^ optional: the expected balance in this commodity in the account after this posting ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types). -- Tying this knot gets tedious, Maybe makes it easier/optional. } deriving (Typeable,Data,Generic) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 54795c736..ce520bf30 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -427,14 +427,14 @@ priceamountp = return $ UnitPrice a)) <|> return NoPrice -partialbalanceassertionp :: Monad m => JournalStateParser m (Maybe MixedAmount) +partialbalanceassertionp :: Monad m => JournalStateParser m (Maybe Amount) partialbalanceassertionp = try (do lift (many spacenonewline) char '=' lift (many spacenonewline) a <- amountp -- XXX should restrict to a simple amount - return $ Just $ Mixed [a]) + return $ Just $ a) <|> return Nothing -- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount) diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index e709c74c8..070d7ea54 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -387,7 +387,7 @@ tests_balanceReport = ] Right samplejournal2 = - journalBalanceTransactions + journalBalanceTransactions False nulljournal{ jtxns = [ txnTieKnot Transaction{ diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index ea130ebbc..8e5440f73 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -71,6 +71,7 @@ library , deepseq , directory , filepath + , hashtables >= 1.2 , megaparsec >=5.0 && < 5.2 , mtl , mtl-compat @@ -168,6 +169,7 @@ test-suite doctests , deepseq , directory , filepath + , hashtables >= 1.2 , megaparsec >=5.0 && < 5.2 , mtl , mtl-compat @@ -256,6 +258,7 @@ test-suite hunittests , deepseq , directory , filepath + , hashtables >= 1.2 , megaparsec >=5.0 && < 5.2 , mtl , mtl-compat diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 0a4d9d353..f10e529b8 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -52,6 +52,7 @@ dependencies: - deepseq - directory - filepath +- hashtables >= 1.2 - megaparsec >=5.0 && < 5.2 - mtl - mtl-compat diff --git a/tests/cli/multiple-files.test b/tests/cli/multiple-files.test index a8e4ffc8c..fd3475001 100644 --- a/tests/cli/multiple-files.test +++ b/tests/cli/multiple-files.test @@ -43,7 +43,7 @@ hledger print -f personal.journal -f business.journal -f alias.journal -f person # 3. files can be of different formats -hledger print -f personal.journal -f a.timeclock -f b.timedot +hledger print -f personal.journal -f ../journal/a.timeclock -f ../journal/b.timedot >>> 2014/01/02 expenses:food $1 @@ -55,6 +55,7 @@ hledger print -f personal.journal -f a.timeclock -f b.timedot 2016/01/01 * (b.bb) 1.00 +>>>2 >>>=0 u \ No newline at end of file diff --git a/tests/i18n/wide-char-layout.test b/tests/i18n/wide-char-layout.test index 863673e86..f410ba60d 100644 --- a/tests/i18n/wide-char-layout.test +++ b/tests/i18n/wide-char-layout.test @@ -31,6 +31,7 @@ hledger -f - print 㐀:㐁:㐂:㐃:㐄 1 㐀 -1 +>>>2 >>>=0 # 2. @@ -42,6 +43,7 @@ hledger -f chinese.journal register --width 80 㐀:㐁:㐂:㐃 -1 0 2014/01/03 transaction 3 㐀:㐁:㐂:㐃:㐄 1 1 㐀 -1 0 +>>>2 >>>=0 # 3. @@ -53,6 +55,7 @@ hledger -f chinese.journal balance 1 㐄 -------------------- 0 +>>>2 >>>=0 # 4. @@ -69,6 +72,7 @@ Balance changes in 2014: ----------------++------- || 0 +>>>2 >>>=0 # 5. diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index 789e88de6..682c2021a 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -136,3 +136,175 @@ hledger -f - stats # >>> /Transactions/ # >>>2 # >>>=0 + +# 8. resetting a balance +hledger -f - stats +<<< +2013/1/1 + a $1.20 + b + +2013/1/2 + a =$1.3 + b + +2013/1/2 + a $10 =$11.3 + b =$-11.3 + +>>> /Transactions/ +>>>2 +>>>=0 + + +# 9. Multiple assertions for an account in the same transaction. +hledger -f - stats +<<< +2013/1/1 + a $1 =$1 + b =-$1 + +2013/1/2 + a $1 =$2 + b $-1 =$-2 + +2013/1/3 + a $2 = $4 + b $-1 = $-3 + b $-1 = $-4 + +>>> /Transactions/ +>>>2 +>>>=0 + +# 10. Multiple assertions and assignments for an account in the same transaction. +hledger -f - stats +<<< +2013/1/1 + a $1 =$1 + b =-$1 + +2013/1/3 + a $6 = $7 + b $-1 = $-2 + b $-1 = $-3 + b $-7 = $-10 + b $-1 + b $-1 = $-12 + b + +2013/1/4 + a $0 = $7 + b $0 = $-7 + +>>> /Transactions/ +>>>2 +>>>=0 + +# 11. Assignments and virtual postings +hledger -f - stats +<<< +2013/1/1 + b + [a] 1$ + (b) = $14 + [b] + a 4$ + + +2013/1/2 + [a] = $5 + b = $9 + + + + +>>> /Transactions/ +>>>2 +>>>=0 +# 12. Having both assignements and posting dates is not supported. +hledger -f - stats +<<< +2013/1/1 + a $1 =$1 + b =$-1 ; date:2012/1/1 + +>>>2 /Not supported/ +>>>=1 + +# 13. Having both assignements 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 /Not supported/ +>>>=1 + +# 14. Posting Date +hledger -f - stats +<<< + +2011/5/5 + [a] = -10 + +2013/1/1 + a 1 = -12 + b + c = 5 + +2014/1/1 + a ; date:2012/1/1 + d 3 = 3 + +2015/1/1 + [a] ; date:2011/1/1 + [d] 10 + + +>>> /Transactions/ +>>>2 +>>>=0 + +# 15. Mix different commodities +hledger -f - stats +<<< +2016/1/1 + a $1 + b -1 zorkmids + +2016/1/2 + a $-1 = $0 + b +>>> /Transactions/ +>>>2 +>>>=0 + +# 16. Mix different commodities and assignments +hledger -f - stats +<<< +2016/1/1 + a $1 + b -1 zorkmids + +2016/1/4 + [a] = $1 + + +2016/1/5 + [a] = -1 zorkmids + +2016/1/2 + a + b = 0 zorkmids +>>> /Transactions/ +>>>2 +>>>=0 \ No newline at end of file diff --git a/tests/journal/virtual-postings.test b/tests/journal/virtual-postings.test index 858fccfa3..bebd25f2a 100644 --- a/tests/journal/virtual-postings.test +++ b/tests/journal/virtual-postings.test @@ -51,4 +51,5 @@ hledger -f- balance -10 f -------------------- 0 +>>>2 >>>=0