diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index c0903adc4..c65064465 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -97,16 +97,18 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs -- check for mixed signs, detecting nonzeros at display precision canonicalise = maybe id canonicaliseMixedAmount commodity_styles_ + postingBalancingAmount p + | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p + | otherwise = mixedAmountCost $ pamount p signsOk ps = - case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of + case filter (not.mixedAmountLooksZero) $ map (canonicalise.postingBalancingAmount) ps of nonzeros | length nonzeros >= 2 -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1 _ -> True (rsignsok, bvsignsok) = (signsOk rps, signsOk bvps) -- check for zero sum, at display precision - (rsum, bvsum) = (sumPostings rps, sumPostings bvps) - (rsumcost, bvsumcost) = (mixedAmountCost rsum, mixedAmountCost bvsum) + (rsumcost, bvsumcost) = (foldMap postingBalancingAmount rps, foldMap postingBalancingAmount bvps) (rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost) (rsumok, bvsumok) = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index aab480658..cee5af69d 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -951,8 +951,10 @@ journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInfer equityAcct = journalConversionAccount j -- | Add inferred transaction prices from equity postings. -journalAddPricesFromEquity :: Journal -> Journal -journalAddPricesFromEquity j = journalMapTransactions (transactionAddPricesFromEquity $ jaccounttypes j) j +journalAddPricesFromEquity :: Journal -> Either String Journal +journalAddPricesFromEquity j = do + ts <- mapM (transactionAddPricesFromEquity $ jaccounttypes j) $ jtxns j + return j{jtxns=ts} -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index bd2e3782c..a8142dbfb 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -423,22 +423,23 @@ postingApplyValuation priceoracle styles periodlast today v p = postingToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Posting -> Maybe Posting postingToCost _ NoConversionOp p = Just p postingToCost styles ToCost p - | ("_matched-conversion-posting","") `elem` ptags p = Nothing - | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p + -- If this is a conversion posting with a matched transaction price posting, ignore it + | "_conversion-matched" `elem` map fst (ptags p) && noCost = Nothing + | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p + where + noCost = null . filter (isJust . aprice) . amountsRaw $ pamount p -- | Generate inferred equity postings from a 'Posting' using transaction prices. -- Make sure not to generate equity postings when there are already matched -- conversion postings. postingAddInferredEquityPostings :: Text -> Posting -> [Posting] postingAddInferredEquityPostings equityAcct p - | ("_matched-transaction-price","") `elem` ptags p = [p] + | "_price-matched" `elem` map fst (ptags p) = [p] | otherwise = taggedPosting : concatMap conversionPostings priceAmounts where taggedPosting | null priceAmounts = p - | otherwise = p{ pcomment = pcomment p `commentAddTag` priceTag - , ptags = priceTag : ptags p - } + | otherwise = p{ ptags = ("_price-matched","") : ptags p } conversionPostings amt = case aprice amt of Nothing -> [] Just _ -> [ cp{ paccount = accountPrefix <> amtCommodity @@ -453,7 +454,7 @@ postingAddInferredEquityPostings equityAcct p amtCommodity = commodity amt costCommodity = commodity cost cp = p{ pcomment = pcomment p `commentAddTag` ("generated-posting","") - , ptags = [("generated-posting", ""), ("_generated-posting", "")] + , ptags = [("_conversion-matched", ""), ("generated-posting", ""), ("_generated-posting", "")] , pbalanceassertion = Nothing , poriginal = Nothing } @@ -461,7 +462,6 @@ postingAddInferredEquityPostings equityAcct p -- Take the commodity of an amount and collapse consecutive spaces to a single space commodity = T.unwords . filter (not . T.null) . T.words . acommodity - priceTag = ("cost", T.strip . wbToText $ foldMap showAmountPrice priceAmounts) priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p -- | Make a market price equivalent to this posting's amount's unit diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 9f31ce281..6d1be1706 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -7,8 +7,10 @@ tags. -} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Hledger.Data.Transaction ( -- * Transaction @@ -44,18 +46,23 @@ module Hledger.Data.Transaction , showTransactionOneLineAmounts , showTransactionLineFirstPart , transactionFile + -- * transaction errors +, annotateErrorWithTransaction -- * tests , tests_Transaction ) where -import Data.Bifunctor (second) -import Data.Maybe (fromMaybe, mapMaybe) +import Control.Monad.Trans.State (StateT(..), evalStateT) +import Data.Bifunctor (first) +import Data.Foldable (foldrM) +import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Semigroup (Endo(..)) import Data.Text (Text) +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, fromGregorian) -import qualified Data.Map as M import Hledger.Utils import Hledger.Data.Types @@ -219,34 +226,120 @@ transactionAddInferredEquityPostings :: AccountName -> Transaction -> Transactio transactionAddInferredEquityPostings equityAcct t = t{tpostings=concatMap (postingAddInferredEquityPostings equityAcct) $ tpostings t} --- | Add inferred transaction prices from equity postings. The transaction --- price will be added to the first posting whose amount is the negation of one --- of the (exactly) two conversion postings, if it exists. -transactionAddPricesFromEquity :: M.Map AccountName AccountType -> Transaction -> Transaction -transactionAddPricesFromEquity acctTypes t - | [(n1, cp1), (n2, cp2)] <- conversionps -- Exactly two conversion postings with indices - , Just ca1 <- maybePostingAmount cp1, Just ca2 <- maybePostingAmount cp2 -- Each conversion posting has exactly one amount - , (np,pricep):_ <- mapMaybe (maybeAddPrice ca1 ca2) npostings -- Get the first posting which matches one of the conversion postings - , let subPosting (n, p) = if n == np then pricep else if n == n1 then cp1 else if n == n2 then cp2 else p - = t{tpostings = map subPosting npostings} - | otherwise = t +-- | Add inferred transaction prices from equity postings. For every adjacent +-- pair of conversion postings, it will first search the postings with +-- transaction prices to see if any match. If so, it will tag it as matched. +-- If no postings with transaction prices match, it will then search the +-- postings without transaction prices, and will match the first such posting +-- which matches one of the conversion amounts. If it finds a match, it will +-- add a transaction price and then tag it. +type IdxPosting = (Int, Posting) +transactionAddPricesFromEquity :: M.Map AccountName AccountType -> Transaction -> Either String Transaction +transactionAddPricesFromEquity acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do + (conversionPairs, stateps) <- partitionPs npostings + f <- transformIndexedPostingsF addPricesToPostings conversionPairs stateps + return t{tpostings = map (snd . f) npostings} where - maybeAddPrice a1 a2 (n,p) - | Just a <- mpamt, amountMatches (-a1) a = Just (n, markPosting p{pamount = mixedAmount a{aprice = Just $ TotalPrice a2}}) - | Just a <- mpamt, amountMatches (-a2) a = Just (n, markPosting p{pamount = mixedAmount a{aprice = Just $ TotalPrice a1}}) - | otherwise = Nothing - where - mpamt = maybePostingAmount p - - conversionps = map (second (`postingAddTags` [("_matched-conversion-posting","")])) - $ filter (\(_,p) -> M.lookup (paccount p) acctTypes == Just Conversion) npostings - markPosting = (`postingAddTags` [("_matched-transaction-price","")]) + -- Include indices for postings npostings = zip [0..] $ tpostings t + transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f + + -- Sort postings into pairs of conversion postings, transaction price postings, and other postings + partitionPs = fmap fst . foldrM select (([], ([], [])), Nothing) + select np@(_, p) ((cs, others@(ps, os)), Nothing) + | isConversion p = Right ((cs, others), Just np) + | hasPrice p = Right ((cs, (np:ps, os)), Nothing) + | otherwise = Right ((cs, (ps, np:os)), Nothing) + select np@(_, p) ((cs, others), Just last) + | isConversion p = Right (((last, np):cs, others), Nothing) + | otherwise = Left "Conversion postings must occur in adjacent pairs" + + -- Given a pair of indexed conversion postings, and a state consisting of lists of + -- priced and unpriced non-conversion postings, create a function which adds transaction + -- prices to the posting which matches the conversion postings if necessary, and tags + -- the conversion and matched postings. Then update the state by removing the matched + -- postings. If there are no matching postings or too much ambiguity, return an error + -- string annotated with the conversion postings. + addPricesToPostings :: (IdxPosting, IdxPosting) + -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting) + addPricesToPostings ((n1, cp1), (n2, cp2)) = StateT $ \(priceps, otherps) -> do + -- Get the two conversion posting amounts, if possible + ca1 <- postingAmountNoPrice cp1 + ca2 <- postingAmountNoPrice cp2 + let -- The function to add transaction prices and tag postings in the indexed list of postings + transformPostingF np pricep = \(n, p) -> + (n, if | n == np -> pricep `postingAddTags` [("_price-matched","")] + | n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")] + | otherwise -> p) + -- All priced postings which match the conversion posting pair + matchingPricePs = mapMaybe (mapM $ pricedPostingIfMatchesBothAmounts ca1 ca2) priceps + -- All other postings which match at least one of the conversion posting pair + matchingOtherPs = mapMaybe (mapM $ addPriceIfMatchesOneAmount ca1 ca2) otherps + + -- Annotate any errors with the conversion posting pair + first (annotateWithPostings [cp1, cp2]) $ + if -- If a single transaction price posting matches the conversion postings, + -- delete it from the list of priced postings in the state, delete the + -- first matching unpriced posting from the list of non-priced postings + -- in the state, and return the transformation function with the new state. + | [(np, (pricep, _))] <- matchingPricePs + , Just newpriceps <- deleteIdx np priceps + -> Right (transformPostingF np pricep, (newpriceps, otherps)) + -- If no transaction price postings match the conversion postings, but some + -- of the unpriced postings match, check that the first such posting has a + -- different amount from all the others, and if so add a transaction price to + -- it, then delete it from the list of non-priced postings in the state, and + -- return the transformation function with the new state. + | [] <- matchingPricePs + , (np, (pricep, amt)):nps <- matchingOtherPs + , not $ any (amountMatches amt . snd . snd) nps + , Just newotherps <- deleteIdx np otherps + -> Right (transformPostingF np pricep, (priceps, newotherps)) + -- Otherwise it's too ambiguous to make a guess, so return an error. + | otherwise -> Left "There is not a unique posting which matches the conversion posting pair:" + + -- If a posting with transaction price matches both the conversion amounts, return it along + -- with the matching amount which must be present in another non-conversion posting. + pricedPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount) + pricedPostingIfMatchesBothAmounts a1 a2 p = do + a@Amount{aprice=Just _} <- postingSingleAmount p + if | amountMatches (-a1) a && amountMatches a2 (amountCost a) -> Just (p, -a2) + | amountMatches (-a2) a && amountMatches a1 (amountCost a) -> Just (p, -a1) + | otherwise -> Nothing + + -- Add a transaction price to a posting if it matches (negative) one of the + -- supplied conversion amounts, adding the other amount as the price + addPriceIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount) + addPriceIfMatchesOneAmount a1 a2 p = do + a <- postingSingleAmount p + let newp price = p{pamount = mixedAmount a{aprice = Just $ TotalPrice price}} + if | amountMatches (-a1) a -> Just (newp a2, a2) + | amountMatches (-a2) a -> Just (newp a1, a1) + | otherwise -> Nothing + + hasPrice p = isJust $ aprice =<< postingSingleAmount p + postingAmountNoPrice p = case postingSingleAmount p of + Just a@Amount{aprice=Nothing} -> Right a + _ -> Left $ annotateWithPostings [p] "The posting must only have a single amount with no transaction price" + postingSingleAmount p = case amountsRaw (pamount p) of + [a] -> Just a + _ -> Nothing - maybePostingAmount p = case amountsRaw $ pamount p of - [a@Amount{aprice=Nothing}] -> Just a - _ -> Nothing amountMatches a b = acommodity a == acommodity b && aquantity a == aquantity b + isConversion p = M.lookup (paccount p) acctTypes == Just Conversion + + -- Delete a posting from the indexed list of postings based on either its + -- index or its posting amount. + -- Note: traversing the whole list to delete a single match is generally not efficient, + -- but given that a transaction probably doesn't have more than four postings, it should + -- still be more efficient than using a Map or another data structure. Even monster + -- transactions with up to 10 postings, which are generally not a good + -- idea, are still too small for there to be an advantage. + deleteIdx n = deleteUniqueMatch ((n==) . fst) + deleteUniqueMatch p (x:xs) | p x = if any p xs then Nothing else Just xs + | otherwise = (x:) <$> deleteUniqueMatch p xs + deleteUniqueMatch _ [] = Nothing + annotateWithPostings xs str = T.unlines $ str : postingsAsLines False xs -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. -- This can fail due to a bad replacement pattern in a regular expression alias. @@ -268,6 +361,13 @@ transactionMapPostingAmounts f = transactionMapPostings (postingTransformAmount transactionFile :: Transaction -> FilePath transactionFile Transaction{tsourcepos} = sourceName $ fst tsourcepos +-- Add transaction information to an error message. +annotateErrorWithTransaction :: Transaction -> String -> String +annotateErrorWithTransaction t s = + unlines [ sourcePosPairPretty $ tsourcepos t, s + , T.unpack . T.stripEnd $ showTransaction t + ] + -- tests tests_Transaction :: TestTree diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 077621124..44eaec65d 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -320,9 +320,9 @@ journalFinalise iopts@InputOpts{..} f txt pj = do >>= (if auto_ && not (null $ jtxnmodifiers pj) then journalAddAutoPostings _ioDay balancingopts_ -- Add auto postings if enabled, and account tags if needed else pure) - >>= journalBalanceTransactions balancingopts_ -- Balance all transactions and maybe check balance assertions. - <$> (if infer_costs_ then journalAddPricesFromEquity else id) -- Add inferred transaction prices from equity postings, if present - <&> (if infer_equity_ then journalAddInferredEquityPostings else id) -- Add inferred equity postings, after balancing transactions and generating auto postings + >>= (if infer_costs_ then journalAddPricesFromEquity else pure) -- Add inferred transaction prices from equity postings, if present + >>= journalBalanceTransactions balancingopts_ -- Balance all transactions and maybe check balance assertions. + <&> (if infer_equity_ then journalAddInferredEquityPostings else id) -- Add inferred equity postings, after balancing and generating auto postings <&> journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions when strict_ $ do journalCheckAccounts j -- If in strict mode, check all postings are to declared accounts diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index 41350287a..ae9700a13 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -14,6 +14,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Time.Calendar (addDays) +import Lens.Micro ((^.)) import System.Console.CmdArgs.Explicit as C import Hledger @@ -48,7 +49,7 @@ closemode = hledgerCommandMode -- debugger, beware: close is incredibly devious. simple rules combine to make a horrid maze. -- tests are in hledger/test/close.test. -close CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do +close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do let -- show opening entry, closing entry, or (default) both ? (opening, closing) = @@ -101,7 +102,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do openingdate = addDays 1 closingdate -- should we show the amount(s) on the equity posting(s) ? - explicit = boolopt "explicit" rawopts + explicit = boolopt "explicit" rawopts || copts ^. infer_costs -- the balances to close (acctbals',_) = balanceReport rspec j diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index d32a3afb8..1231a751b 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -75,11 +75,13 @@ printEntries opts@CliOpts{reportspec_=rspec} j = entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text entriesReportAsText opts = - TB.toLazyText . foldMap (TB.fromText . showTransaction . maybeStripPrices . whichtxn) + TB.toLazyText . foldMap (TB.fromText . showTransaction . whichtxn) where whichtxn -- With -x, use the fully-inferred txn with all amounts & txn prices explicit. | boolopt "explicit" (rawopts_ opts) = id + -- With --show-costs, make txn prices explicit. + | opts ^. infer_costs = id -- Or also, if any of -B/-V/-X/--value are active. -- Because of #551, and because of print -V valuing only one -- posting when there's an implicit txn price. @@ -87,11 +89,6 @@ entriesReportAsText opts = | has (value . _Just) opts = id -- By default, use the original as-written-in-the-journal txn. | otherwise = originalTransaction - maybeStripPrices - -- Strip prices when inferring equity, unless the show_costs_ is set - | opts ^. infer_equity && not (opts ^. show_costs) = - transactionTransformPostings postingStripPrices - | otherwise = id -- Replace this transaction's postings with the original postings if any, but keep the -- current possibly rewritten account names, and the inferred values of any auto postings diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 0ae5cc10b..d249d13b2 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -993,7 +993,7 @@ Pro: Con: -- Disturbs the accounting equation +- Disturbs the accounting equation without the --infer-equity flag ### Equity conversion @@ -1014,16 +1014,17 @@ Pro: - Preserves the accounting equation - keeps track of conversions and related gains/losses in one place - works in any double entry accounting system +- hledger can convert this to transaction prices using the --infer-costs flag Con: - More verbose - conversion rate is not clear -- hledger can not do cost reporting +- depends on the order of postings ### Priced equity conversion -Another possible notation would be to record both the conversion rate and the equity postings: +Another notation is to record both the conversion rate and the equity postings: ```journal 2021-01-01 @@ -1033,7 +1034,19 @@ Another possible notation would be to record both the conversion rate and the eq assets:cash 120 USD ``` -hledger currently does not allow this; instead, you can record the conversion rate as a comment. +Pro: + +- Preserves the accounting equation +- keeps track of conversions and related gains/losses in one place +- makes the conversion rate clear +- provides some error checking +- hledger can do cost reporting + +Con: + +- Most verbose +- Requires --infer-costs flag +- Not compatible with ledger ## Inferring missing conversion rates @@ -1041,23 +1054,27 @@ hledger will do this automatically for implicit conversions. Currently it can no ## Inferring missing equity postings -With the `--infer-equity` flag, hledger will add equity postings to priced and implicit conversions (and move the conversion rate into a comment). +With the `--infer-equity` flag, hledger will add equity postings to priced and implicit conversions. + +## Inferring missing transaction prices from equity postings + +With the `--infer-costs` flag, hledger will add transaction prices from equity postings, and will be able to handle transaction prices and equity postings together. ## Cost reporting With the `-B/--cost` flag, hledger will convert the amounts in priced and implicit conversions to their cost in the other commodity. This is useful to see a report of what you paid for things (or how much you sold things for). Currently `-B/--cost` does not work on equity conversions, and it disables `--infer-equity`. These operations are transient, only affecting reports. If you want to change the journal file permanently, you could pipe each entry through -`hledger -f- -I print [-x] [--infer-equity] [-B]` +`hledger -f- -I print [-x] [--infer-equity] [--infer-costs] [-B]` ## Conversion summary - Recording the conversion rate is good because it makes that clear and allows cost reporting. - Recording equity postings is good because it balances the accounting equation and is correct bookkeeping. -- Combining these is not yet supported, so you have to choose. For now, priced conversions are a good compromise, so that: - - When you want to see the cost (or sale proceeds) of things, use `-B/--cost`. - - When you want to see a balanced balance sheet or correct journal entries, use `--infer-equity`. - - Combining these is not yet supported; `-B/--cost` will take precedence. +- Combining these is possible with the --infer-costs flag, but has certain requirements for the order of postings. +- When you want to see the cost (or sale proceeds) of things, use `-B/--cost`. +- When you want to see a balanced balance sheet or correct journal entries, use `--infer-equity`. +- `--cost` will remove any balancing equity posts, so as not to disturb the accounting equation. - Conversion/cost operations are performed before valuation. @@ -2462,6 +2479,81 @@ $ hledger bal -N --flat -B €100 assets:euros ``` +### Equity conversion postings + +Transaction prices can be converted to and from equity conversion postings +using the `--infer-equity` and `--infer-costs` flags. + +With `--infer-equity`, hledger will add equity postings to balance out any +transaction prices. + +```journal +2009/1/1 + assets:euros €100 @ $1.35 ; 100 euros bought + assets:dollars -$135 ; for $135 +``` +```shell +$ hledger print --infer-equity + +2009-01-01 + assets:euros €100 @ $1.35 ; 100 euros bought + equity:conversion:$-€:€ €-100 ; 100 euros bought, generated-posting: + equity:conversion:$-€:$ $135.00 ; 100 euros bought, generated-posting: + assets:dollars $-135 ; for $135 +``` + +The reverse is possible using `--infer-costs`, which will check any equity +conversion postings and generate a transaction price for the _first_ +non-conversion posting which matches. + +```journal +2009-01-01 + assets:euros €100 ; 100 euros bought + equity:conversion €-100 + equity:conversion $135 + assets:dollars $-135 ; for $135 +``` +```shell +$ hledger print --infer-costs + +2009-01-01 + assets:euros €100 @@ $135 ; 100 euros bought + equity:conversion €-100 + equity:conversion $135 + assets:dollars $-135 ; for $135 +``` + +Note that the above will assign the transaction price to the first matching +posting in the transaction. +If you want to assign it to a different posting, or if you have several +different sets of conversion postings which must match different postings, you +must manually specify the transaction price. +If you do this, equity conversion postings must occur in adjacent pairs and +must exactly match the amount of a non-conversion posting. + +```journal +2009-01-01 + assets:dollars $-135 ; $135 paid + equity:conversion €-100 + equity:conversion $135 + assets:euros €100 @@ $135 ; to buy 100 euros +``` + +```journal +2009-01-01 + assets:euros €100 @ $1.35 ; 100 euros bought + equity:conversion €-100 + equity:conversion $135 + assets:pounds £80 @@ $100 ; 80 pounds bought + equity:conversion £-80 + equity:conversion $100 + assets:dollars $-235 ; for $235 total +``` + +The account names used for the conversion accounts can be changed with the +[conversion account type declaration](#account-types). + + ## Lot prices, lot dates Ledger allows another kind of price, diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index 29edf96ef..925981b99 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -1,90 +1,63 @@ # price-related tests -# 1. print a transaction with an explicit unit price -hledger -f- print --explicit -<<< +< 2011/01/01 expenses:foreign currency €100 @ $1.35 assets ->>> + +# 1. print a transaction with an explicit unit price +$ hledger -f- print --explicit 2011-01-01 expenses:foreign currency €100 @ $1.35 assets $-135.00 ->>>=0 +>=0 # 2. -B/--cost converts to the price's commodity ("cost") -hledger -f- print --explicit --cost -<<< -2011/01/01 - expenses:foreign currency €100 @ $1.35 - assets ->>> +$ hledger -f- print --explicit --cost 2011-01-01 expenses:foreign currency $135.00 assets $-135.00 ->>>=0 +>=0 +< +2011/01/01 + expenses:foreign currency €100 @ $1.35 + assets $-135.00 # 3. --infer-equity generates conversion postings -hledger -f- print --infer-equity -<<< -2011/01/01 - expenses:foreign currency €100 @ $1.35 - assets ->>> +$ hledger -f- print --infer-equity 2011-01-01 - expenses:foreign currency €100 ; cost: @ $1.35 + expenses:foreign currency €100 @ $1.35 equity:conversion:$-€:€ €-100 ; generated-posting: equity:conversion:$-€:$ $135.00 ; generated-posting: - assets + assets $-135.00 ->>>=0 +>=0 -# 4. With --infer-equity and --show-costs, the cost is still shown -hledger -f- print --infer-equity --show-costs -<<< -2011/01/01 - expenses:foreign currency €100 @ $1.35 - assets ->>> -2011-01-01 - expenses:foreign currency €100 @ $1.35 ; cost: @ $1.35 - equity:conversion:$-€:€ €-100 ; generated-posting: - equity:conversion:$-€:$ $135.00 ; generated-posting: - assets - ->>>=0 - -# 5. With --cost, --infer-equity is ignored -hledger -f- print --explicit --cost --infer-equity -<<< -2011/01/01 - expenses:foreign currency €100 @ $1.35 - assets ->>> +# 4. With --cost, --infer-equity is ignored +$ hledger -f- print --cost --infer-equity 2011-01-01 expenses:foreign currency $135.00 assets $-135.00 ->>>=0 +>=0 -# 6. print a transaction with a total price -hledger -f - print --explicit -<<< +< 2011/01/01 - expenses:foreign currency €100 @@ $135 + expenses:foreign currency €100 @@ $135 assets ->>> + +# 5. print a transaction with a total price +$ hledger -f - print --explicit 2011-01-01 expenses:foreign currency €100 @@ $135 assets $-135 ->>>=0 +>=0 -# 7. when the balance has exactly two commodities, both unpriced, infer an +# 6. when the balance has exactly two commodities, both unpriced, infer an # implicit conversion price for the first one in terms of the second. -hledger -f - print --explicit -<<< +< 2011/01/01 expenses:foreign currency €100 misc $2.1 @@ -92,7 +65,8 @@ hledger -f - print --explicit misc €1 misc €-1 misc $-2.1 ->>> + +$ hledger -f - print --explicit 2011-01-01 expenses:foreign currency €100 @ $1.35 misc $2.10 @@ -101,325 +75,432 @@ hledger -f - print --explicit misc €-1 @ $1.35 misc $-2.10 ->>>=0 +>=0 -# 8. another, from ledger tests. Just one posting to price so uses @@. -hledger -f - print --explicit -<<< +# 7. another, from ledger tests. Just one posting to price so uses @@. +< 2002/09/30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be c56a21d23a6535184e7152ee138c28974f14280c 866.231000 GGGGG a35e82730cf91569c302b313780e5895f75a62b9 $-17,783.72 ->>> + +$ hledger -f - print --explicit 2002-09-30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be c56a21d23a6535184e7152ee138c28974f14280c 866.231000 GGGGG @@ $17,783.72 a35e82730cf91569c302b313780e5895f75a62b9 $-17,783.72 ->>>=0 +>=0 -# 9. when the balance has more than two commodities, don't bother -hledger -f - print -<<< +# 8. when the balance has more than two commodities, don't bother +< 2011/01/01 expenses:foreign currency €100 assets $-135 expenses:other £200 ->>>= !0 +$ hledger -f - print +>2 /unbalanced transaction/ +>= !0 -# 10. another -hledger -f - balance -B -<<< +# 9. another +< 2011/01/01 expenses:foreign currency €99 assets $-130 expenses:foreign currency €1 assets $-5 ->>> + +$ hledger -f - balance -B $-135 assets $135 expenses:foreign currency -------------------- 0 ->>>=0 +>=0 -# 11. transaction in two commodities should balance out properly -hledger -f - balance --cost -<<< +# 10. transaction in two commodities should balance out properly +< 2011/01/01 x a 10£ @@ 16$ b ->>> + +$ hledger -f - balance --cost 16$ a -16$ b -------------------- 0 ->>>=0 +>=0 -# 12. --value=cost,XXX is deprecated, but should still work (for now) -hledger -f - balance --value=cost,XXX -<<< -2011/01/01 x - a 10£ @@ 16$ - b ->>> +# 11. --value=cost,XXX is deprecated, but should still work (for now) +$ hledger -f - balance --value=cost,XXX 16$ a -16$ b -------------------- 0 ->>>=0 +>=0 -# 13. conversion postings should be generated when called --infer-equity -hledger -f - balance --infer-equity -<<< -2011/01/01 x - a 10£ @@ 16$ - b ->>> +# 12. conversion postings should be generated when called --infer-equity +$ hledger -f - balance --infer-equity 10£ a -16$ b 16$ equity:conversion:$-£:$ -10£ equity:conversion:$-£:£ -------------------- 0 ->>>=0 +>=0 -# 14. transaction should be left unbalanced when called without --cost or --infer-equity -hledger -f - balance -<<< -2011/01/01 x - a 10£ @@ 16$ - b ->>> +# 13. transaction should be left unbalanced when called without --cost or --infer-equity +$ hledger -f - balance 10£ a -16$ b -------------------- -16$ 10£ ->>>=0 +>=0 -# 15. When commodity price is specified implicitly, transaction should +# 14. When commodity price is specified implicitly, transaction should # be considered balanced out even when first amount is negative # (that is, price for it should be determined properly, with proper sign) -hledger -f - balance -N -<<< +< 2011/01/01 x a -10£ b 16$ ->>> + +$ hledger -f - balance -N -10£ a 16$ b ->>>=0 +>=0 -# 16. Should not infer prices when --strict is specified -hledger -f - balance --strict -<<< -2011/01/01 x - a -10£ - b 16$ ->>> ->>>=1 +# 15. Should not infer prices when --strict is specified +$ hledger -f - balance --strict +>2 /unbalanced transaction/ +>=1 -# 17. When commodity price is specified implicitly, transaction should -# NOT be considered balanced out when BOTH amounts are negative -hledger -f - balance -<<< +< 2011/01/01 x a -10£ b -16$ ->>> ->>>=1 -# 18. Differently-priced lots of a commodity should be merged in balance report -hledger -f - balance -<<< +# 16. When commodity price is specified implicitly, transaction should +# NOT be considered balanced out when BOTH amounts are negative +$ hledger -f - balance +>2 /unbalanced transaction/ +>=1 + +# 17. Differently-priced lots of a commodity should be merged in balance report +< 2011/1/1 (a) £1 @ $2 2011/1/1 (a) £1 @ $3 ->>> + +$ hledger -f - balance £2 a -------------------- £2 ->>>=0 +>=0 -# 19. this should balance -hledger -f - balance -<<< +# 18. this should balance +< 2011/1/1 a 1h @ $10 b 1h @ $20 c $-30 ->>>= 0 -# 20. these balance because of the unit prices, and should parse successfully -hledger -f - balance --no-total -<<< +$ hledger -f - balance --no-total + 1h a + 1h b + $-30 c +>= 0 + +# 19. these balance because of the unit prices, and should parse successfully +< 1/1 a 1X @ 2Y a -2X @ 1Y ->>> + +$ hledger -f - balance --no-total -1X a ->>>= 0 +>= 0 -# 21. -hledger -f - balance --no-total -B -<<< -1/1 - a 1X @ 2Y - a -2X @ 1Y ->>> ->>>= 0 +# 20. +$ hledger -f - balance --no-total -B +>= 0 -# 22. likewise with total prices. Note how the primary amount's sign is used. -hledger -f - balance --no-total -<<< +# 21. likewise with total prices. Note how the primary amount's sign is used. +< 1/1 a 1X @@ 1Y a -2X @@ 1Y ->>> + +$ hledger -f - balance --no-total -1X a ->>>= 0 +>= 0 -# 23. -hledger -f - balance --no-total -B -<<< -1/1 - a 1X @@ 1Y - a -2X @@ 1Y ->>> ->>>= 0 +# 22. +$ hledger -f - balance --no-total -B +>= 0 -# 24. here, a's primary amount is 0, and its cost is 1Y; b is the assigned auto-balancing amount of -1Y (per issue 69) -hledger -f - balance --no-total -E -<<< +# 23. here, a's primary amount is 0, and its cost is 1Y; b is the assigned auto-balancing amount of -1Y (per issue 69) +< 1/1 a 1X @@ 1Y a 1X @@ 1Y a -2X @@ 1Y b ->>> + +$ hledger -f - balance --no-total -E 0 a -1Y b ->>>= 0 +>= 0 -# 25. Without -E, a should be hidden because its balance is zero, even though it has a non-zero cost. -hledger -f - balance --no-total -<<< -1/1 - a 1X @@ 1Y - a 1X @@ 1Y - a -2X @@ 1Y - b ->>> +# 24. Without -E, a should be hidden because its balance is zero, even though it has a non-zero cost. +$ hledger -f - balance --no-total -1Y b ->>>= 0 +>= 0 -# 26. the above with -B -hledger -f - balance --no-total -E -B -<<< -1/1 - a 1X @@ 1Y - a 1X @@ 1Y - a -2X @@ 1Y - b ->>> +# 25. the above with -B +$ hledger -f - balance --no-total -E -B 1Y a -1Y b ->>>= 0 +>= 0 -# 27. The equity account used by --infer-equity can be customised -hledger -f- print --infer-equity -<<< +# 26. The equity account used by --infer-equity can be customised +< account equity:trades ; type:V 2011/01/01 expenses:foreign currency €100 @ $1.35 assets ->>> + +$ hledger -f- print --infer-equity 2011-01-01 - expenses:foreign currency €100 ; cost: @ $1.35 + expenses:foreign currency €100 @ $1.35 equity:trades:$-€:€ €-100 ; generated-posting: equity:trades:$-€:$ $135.00 ; generated-posting: assets ->>>=0 +>=0 -# 28. Inferred equity postings are generated early enough to match filters -hledger -f- areg --infer-equity equity:conversion -<<< +# 27. Inferred equity postings are generated early enough to match filters +< 2011/01/01 expenses:foreign currency €100 @ $1.35 assets ->>> + +$ hledger -f- areg --infer-equity equity:conversion Transactions in equity:conversion and subaccounts: 2011-01-01 ex:foreign currenc.. $135.00 $135.00 €-100 €-100 ->>>=0 +>=0 -# 29. Infer cost when equity postings are present -hledger -f- print --cost --infer-costs -<<< +# 28. Infer cost with first matching posting when equity postings are present +< 2011/01/01 expenses:foreign currency €100 equity:conversion €-100 equity:conversion $135 - assets ->>> + assets $-135 + +$ hledger -f- print --infer-costs +2011-01-01 + expenses:foreign currency €100 @@ $135 + equity:conversion €-100 + equity:conversion $135 + assets $-135 + +>=0 + +# 29. Infer cost and convert to cost when equity postings are present +$ hledger -f- print --infer-costs --cost 2011-01-01 expenses:foreign currency $135 - assets + assets $-135 ->>>=0 +>=0 -# 30. Infer cost and show it when equity postings are present -hledger -f- print --show-costs --infer-costs -<<< -2011/01/01 - expenses:foreign currency €100 - equity:conversion €-100 - equity:conversion $135 - assets ->>> +# 30. Do not infer equity postings when they are specified manually +$ hledger -f- print --infer-equity --infer-costs 2011-01-01 expenses:foreign currency €100 @@ $135 equity:conversion €-100 equity:conversion $135 - assets + assets $-135 ->>>=0 +>=0 -# 31. Do not infer equity postings when they are specified manually -hledger -f- print --show-costs --infer-equity --infer-costs -<<< -2011/01/01 - expenses:foreign currency €100 - equity:conversion €-100 - equity:conversion $135 - assets ->>> -2011-01-01 - expenses:foreign currency €100 @@ $135 - equity:conversion €-100 - equity:conversion $135 - assets - ->>>=0 - -# 32. Inferred equity postings with non-standard conversion account -hledger -f- print --cost --infer-costs -<<< +# 31. Inferred equity postings with non-standard conversion account +< account whoopwhoop ; type:V 2011/01/01 expenses:foreign currency €100 whoopwhoop €-100 whoopwhoop $135 - assets ->>> -2011-01-01 - expenses:foreign currency $135 - assets + assets $-135 ->>>=0 +$ hledger -f- print --infer-costs +2011-01-01 + expenses:foreign currency €100 @@ $135 + whoopwhoop €-100 + whoopwhoop $135 + assets $-135 + +>=0 + +# 32. Can manually make another posting match +< +2011/01/01 + assets $-135 + equity:conversion €-100 + equity:conversion $135 + expenses:foreign currency €100 @@ $135 + +$ hledger -f- print --infer-costs +2011-01-01 + assets $-135 + equity:conversion €-100 + equity:conversion $135 + expenses:foreign currency €100 @@ $135 + +>=0 + +# 33. Can manually match lots of different posting groups so long as there is no conflict +< +2011/01/01 + expenses:food €110 @@ £80 + expenses:foreign currency €100 @@ $135 + equity:conversion €-100 + equity:conversion $135 + equity:trades €-110 + equity:trades £80 + assets $-135 + assets £-80 + +$ hledger -f- print --show-costs --infer-costs +2011-01-01 + expenses:food €110 @@ £80 + expenses:foreign currency €100 @@ $135 + equity:conversion €-100 + equity:conversion $135 + equity:trades €-110 + equity:trades £80 + assets $-135 + assets £-80 + +>=0 + +# 34. And convert to cost +$ hledger -f- print --cost --infer-costs --cost +2011-01-01 + expenses:food £80 + expenses:foreign currency $135 + assets $-135 + assets £-80 + +>=0 + +# 35. Transaction posts and equity conversion postings are fine +< +2011/01/01 + expenses:foreign currency €100 @ $1.35 + equity:conversion €-100 + equity:conversion $135 + assets $-135 + +$ hledger -f- print --infer-costs +2011-01-01 + expenses:foreign currency €100 @ $1.35 + equity:conversion €-100 + equity:conversion $135 + assets $-135 + +>=0 + +# 36. Conversion postings should come in adjacent pairs +< +2011/01/01 + expenses:foreign currency €100 @@ $135 + equity:conversion €-100 + assets $-135 + equity:conversion $135 + +$ hledger -f- print --infer-costs +>2 /Conversion postings must occur in adjacent pairs/ +>=1 + +# 37. If a conversion pair matches several postings it should throw an error +< +2011/01/01 + expenses:foreign currency €100 @@ $135 + expenses:foreign trades €100 @@ $135 + equity:conversion €-100 + equity:conversion $135 + assets €-100 + assets $-135 + +$ hledger -f- print --infer-costs +>2 /There is not a unique posting which matches the conversion posting pair/ +>=1 + +# 38. If a conversion pair does not match it should throw an error +< +2011/01/01 + expenses:foreign currency €120 + equity:conversion €-100 + equity:conversion $135 + assets:extra $20 + assets €-20 + assets $-155 + +$ hledger -f- print --infer-costs +>2 /There is not a unique posting which matches the conversion posting pair/ +>=1 + +# 39. Multiple conversion pairs which match a single posting should cause an +# error, and should not match both ‘sides’ of the conversion +< +2011/01/01 + expenses:foreign currency €100 + equity:conversion €-100 + equity:conversion $135 + equity:conversion €-100 + equity:conversion $135 + assets $-270 + assets €100 + +$ hledger -f- print --infer-costs +>2 /There is not a unique posting which matches the conversion posting pair/ +>=1 + +# 40. We can combine ‘other’ amounts into one posting, if they still match up. +< +2011-01-01 + expenses:foreign currency €100 @ $1.35 + expenses:foreign currency £100 @ $1.36 + expenses:foreign currency ¥1000 @@ €8.00 + equity:conversion €-100 + equity:conversion $135 + equity:conversion £-100 + equity:conversion $136 + equity:conversion ¥-1000 + equity:conversion €8.00 + assets $-271 + assets €-8.00 + +$ hledger -f- print --infer-costs +2011-01-01 + expenses:foreign currency €100.00 @ $1.35 + expenses:foreign currency £100 @ $1.36 + expenses:foreign currency ¥1000 @@ €8.00 + equity:conversion €-100.00 + equity:conversion $135 + equity:conversion £-100 + equity:conversion $136 + equity:conversion ¥-1000 + equity:conversion €8.00 + assets $-271 + assets €-8.00 + +>=0 # # when the *cost-basis* balance has exactly two commodities, both # # unpriced, infer an implicit conversion price for the first one in terms