From 8eedbbbe87ee7d07dd2622e5f9141176e76157ec Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 4 May 2021 11:15:55 +1000 Subject: [PATCH] imp: cost: Generate totally balanced conversion postings for amounts with costs. Introduce --infer-equity option which will generate conversion postings. --cost will override --infer-equity. This means there will no longer be unbalanced transactions, but will be offsetting conversion postings to balance things out. For example. 2000-01-01 a 1 AAA @@ 2 BBB b -2 BBB When converting to cost, this is treated the same as before. When used with --infer-equity, this is now treated as: 2000-01-01 a 1 AAA equity:conversion:AAA-BBB:AAA -1 AAA equity:conversion:AAA-BBB:BBB 2 BBB b -2 BBB There is a new account type, Conversion/V, which is a subtype of Equity/E. The first account declared with this type, if any, is used as the base account for inferred equity postings in conversion transactions, overriding the default "equity:conversion". API changes: Costing has been changed to ConversionOp with three options: NoConversionOp, ToCost, and InferEquity. The first correspond to the previous NoCost and Cost options, while the third corresponds to the --infer-equity flag. This converts transactions with costs (one or more transaction prices) to transactions with equity:conversion postings. It is in ConversionOp because converting to cost with -B/--cost and inferring conversion equity postings with --infer-equity are mutually exclusive. Correspondingly, the cost_ record of ReportOpts has been changed to conversionop_. This also removes show_costs_ option in ReportOpts, as its functionality has been replaced by the richer cost_ option. --- hledger-lib/Hledger/Data/Amount.hs | 1 + hledger-lib/Hledger/Data/Journal.hs | 23 ++- hledger-lib/Hledger/Data/Posting.hs | 42 ++++- hledger-lib/Hledger/Data/Transaction.hs | 8 +- hledger-lib/Hledger/Data/Types.hs | 1 + hledger-lib/Hledger/Data/Valuation.hs | 17 +- hledger-lib/Hledger/Read/JournalReader.hs | 32 ++-- hledger-lib/Hledger/Reports/BalanceReport.hs | 2 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 12 +- hledger-lib/Hledger/Reports/EntriesReport.hs | 2 +- .../Hledger/Reports/MultiBalanceReport.hs | 4 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 93 ++++++----- hledger-ui/Hledger/UI/AccountsScreen.hs | 4 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 4 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 18 +-- hledger-ui/Hledger/UI/UIState.hs | 10 +- hledger/Hledger/Cli/CliOptions.hs | 2 + hledger/Hledger/Cli/Commands/Balance.hs | 6 +- hledger/Hledger/Cli/Commands/Close.hs | 15 +- hledger/Hledger/Cli/Commands/Print.hs | 12 +- hledger/Hledger/Cli/Commands/Roi.hs | 2 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 6 +- hledger/hledger.m4.md | 26 +++- hledger/test/journal/transaction-prices.test | 145 +++++++++++++++--- 24 files changed, 336 insertions(+), 151 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 1dfb00f74..29fdb156b 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -80,6 +80,7 @@ module Hledger.Data.Amount ( amountUnstyled, showAmountB, showAmount, + showAmountPrice, cshowAmount, showAmountWithZeroCommodity, showAmountDebug, diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 4f515190d..039c4e3fa 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -80,6 +80,7 @@ module Hledger.Data.Journal ( journalLiabilityAccountQuery, journalEquityAccountQuery, journalCashAccountQuery, + journalConversionAccount, -- * Misc canonicalStyleFrom, nulljournal, @@ -120,9 +121,10 @@ import Hledger.Utils import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount +import Hledger.Data.Posting import Hledger.Data.Transaction import Hledger.Data.TransactionModifier -import Hledger.Data.Posting +import Hledger.Data.Valuation import Hledger.Query @@ -395,7 +397,8 @@ letterPairs _ = [] -- queries for standard account types -- | Get a query for accounts of the specified types in this journal. --- Account types include Asset, Liability, Equity, Revenue, Expense, Cash. +-- Account types include: +-- Asset, Liability, Equity, Revenue, Expense, Cash, Conversion. -- For each type, if no accounts were declared with this type, the query -- will instead match accounts with names matched by the case-insensitive -- regular expression provided as a fallback. @@ -506,6 +509,13 @@ journalProfitAndLossAccountQuery j = Or [journalRevenueAccountQuery j ,journalExpenseAccountQuery j ] +-- | The 'AccountName' to use for automatically generated conversion postings. +journalConversionAccount :: Journal -> AccountName +journalConversionAccount = + headDef (T.pack "equity:conversion") + . M.findWithDefault [] Conversion + . jdeclaredaccounttypes + -- Various kinds of filtering on journals. We do it differently depending -- on the command. @@ -870,10 +880,11 @@ postingInferredmarketPrice p@Posting{pamount} = -- | Convert all this journal's amounts to cost using the transaction prices, if any. -- The journal's commodity styles are applied to the resulting amounts. -journalToCost :: Journal -> Journal -journalToCost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles) ts} - where - styles = journalCommodityStyles j +journalToCost :: ConversionOp -> Journal -> Journal +journalToCost cost j@Journal{jtxns=ts} = + j{jtxns=map (transactionToCost (journalConversionAccount j) styles cost) ts} + where + styles = journalCommodityStyles j -- -- | 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 563249432..13873a9d8 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -81,7 +81,7 @@ import Data.Foldable (asum) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust) import Data.MemoUgly (memo) -import Data.List (foldl') +import Data.List (foldl', sort) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T @@ -480,9 +480,43 @@ postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day postingApplyValuation priceoracle styles periodlast today v p = postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p --- | Convert this posting's amount to cost, and apply the appropriate amount styles. -postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting -postingToCost styles = postingTransformAmount (styleMixedAmount styles . mixedAmountCost) +-- | Maybe convert this 'Posting's amount to cost, and apply apply appropriate +-- amount styles; or, in --infer-equity mode, remove its cost price and add an +-- appropriate pair of equity postings. +postingToCost :: Text -> M.Map CommoditySymbol AmountStyle -> ConversionOp -> Posting -> [Posting] +postingToCost _ _ NoConversionOp p = [p] +postingToCost _ styles ToCost p = [postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p] +postingToCost equityAcct styles InferEquity p = taggedPosting : concatMap conversionPostings priceAmounts + where + taggedPosting + | null priceAmounts = p + | otherwise = p{ pcomment = pcomment p `commentAddTag` priceTag + , ptags = priceTag : ptags p + } + conversionPostings amt = case aprice amt of + Nothing -> [] + Just _ -> [ cp{ paccount = accountPrefix <> amtCommodity + , pamount = mixedAmount . negate $ amountStripPrices amt + } + , cp{ paccount = accountPrefix <> costCommodity + , pamount = styleMixedAmount styles $ mixedAmount cost + } + ] + where + cost = amountCost amt + amtCommodity = commodity amt + costCommodity = commodity cost + cp = p{ pcomment = pcomment p `commentAddTag` ("generated-posting","") + , ptags = [("generated-posting", ""), ("_generated-posting", "")] + , pbalanceassertion = Nothing + , poriginal = Nothing + } + accountPrefix = mconcat [ equityAcct, ":", T.intercalate "-" $ sort [amtCommodity, costCommodity], ":"] + -- 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 -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 726984d71..0a6d1f3ad 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -202,9 +202,11 @@ transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> transactionApplyValuation priceoracle styles periodlast today v = transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v) --- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. -transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction -transactionToCost styles = transactionTransformPostings (postingToCost styles) +-- | Maybe convert this 'Transaction's amounts to cost and apply the +-- appropriate amount styles; or in --infer-equity mode, replace any +-- transaction prices by a pair of equity postings. +transactionToCost :: Text -> M.Map CommoditySymbol AmountStyle -> ConversionOp -> Transaction -> Transaction +transactionToCost equityAcct styles cost t = t{tpostings=concatMap (postingToCost equityAcct styles cost) $ tpostings t} -- | 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. diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index cce06d6f0..744d4884a 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -151,6 +151,7 @@ data AccountType = | Revenue | Expense | Cash -- ^ a subtype of Asset - liquid assets to show in cashflow report + | Conversion -- ^ a subtype of Equity - account in which to generate conversion postings for transaction prices deriving (Show,Eq,Ord,Generic) -- not worth the trouble, letters defined in accountdirectivep for now diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 786bb5a53..d698b3229 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -13,7 +13,7 @@ looking up historical market prices (exchange rates) between commodities. {-# LANGUAGE DeriveGeneric #-} module Hledger.Data.Valuation ( - Costing(..) + ConversionOp(..) ,ValuationType(..) ,PriceOracle ,journalPriceOracle @@ -51,8 +51,8 @@ import Text.Printf (printf) ------------------------------------------------------------------------------ -- Types --- | Whether to convert amounts to cost. -data Costing = Cost | NoCost +-- | Which operation to perform on conversion transactions. +data ConversionOp = NoConversionOp | InferEquity | ToCost deriving (Show,Eq) -- | What kind of value conversion should be done on amounts ? @@ -98,8 +98,8 @@ priceDirectiveToMarketPrice PriceDirective{..} = -- Converting things to value -- | Convert all component amounts to cost/selling price if requested, and style them. -mixedAmountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -mixedAmountToCost cost styles = mapMixedAmount (amountToCost cost styles) +mixedAmountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> MixedAmount -> MixedAmount +mixedAmountToCost styles cost = mapMixedAmount (amountToCost styles cost) -- | Apply a specified valuation to this mixed amount, using the -- provided price oracle, commodity styles, and reference dates. @@ -109,9 +109,10 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v) -- | Convert an Amount to its cost if requested, and style it appropriately. -amountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Amount -> Amount -amountToCost NoCost _ = id -amountToCost Cost styles = styleAmount styles . amountCost +amountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount +amountToCost styles ToCost = styleAmount styles . amountCost +amountToCost _ InferEquity = amountStripPrices +amountToCost _ NoConversionOp = id -- | Apply a specified valuation to this amount, using the provided -- price oracle, and reference dates. Also fix up its display style diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index dbf61fa60..88aafa8f2 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -351,7 +351,7 @@ accountdirectivep = do -- XXX added in 1.11, deprecated in 1.13, remove in 1.14 mtypecode :: Maybe Char <- lift $ optional $ try $ do skipNonNewlineSpaces1 -- at least one more space in addition to the one consumed by modifiedaccountp - choice $ map char "ALERX" + choice $ map char "ALERXV" -- maybe a comment, on this and/or following lines (cmt, tags) <- lift transactioncommentp @@ -378,22 +378,24 @@ accountTypeTagName = "type" parseAccountTypeCode :: Text -> Either String AccountType parseAccountTypeCode s = case T.toLower s of - "asset" -> Right Asset - "a" -> Right Asset - "liability" -> Right Liability - "l" -> Right Liability - "equity" -> Right Equity - "e" -> Right Equity - "revenue" -> Right Revenue - "r" -> Right Revenue - "expense" -> Right Expense - "x" -> Right Expense - "cash" -> Right Cash - "c" -> Right Cash - _ -> Left err + "asset" -> Right Asset + "a" -> Right Asset + "liability" -> Right Liability + "l" -> Right Liability + "equity" -> Right Equity + "e" -> Right Equity + "revenue" -> Right Revenue + "r" -> Right Revenue + "expense" -> Right Expense + "x" -> Right Expense + "cash" -> Right Cash + "c" -> Right Cash + "conversion" -> Right Conversion + "v" -> Right Conversion + _ -> Left err where err = T.unpack $ "invalid account type code "<>s<>", should be one of " <> - T.intercalate ", " ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"] + T.intercalate ", " ["A","L","E","R","X","C","V","Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"] -- Add an account declaration to the journal, auto-numbering it. addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m () diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index e7386c8b0..f638e8f56 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -313,7 +313,7 @@ tests_BalanceReport = testGroup "BalanceReport" [ ," a:b 10h @ $50" ," c:d " ]) >>= either error' return - let j' = journalCanonicaliseAmounts $ journalToCost j -- enable cost basis adjustment + let j' = journalCanonicaliseAmounts $ journalToCost ToCost j -- enable cost basis adjustment balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is` [" $500 a:b" ," $-500 c:d" diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index c0d22c08b..5e7e8a0c0 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -218,9 +218,9 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ balanceReportTableAsText ropts (budgetReportAsTable ropts budgetr) where title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr) - <> (case cost_ of - Cost -> ", converted to cost" - NoCost -> "") + <> (case conversionop_ of + Just ToCost -> ", converted to cost" + _ -> "") <> (case value_ of Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) -> ", valued at period ends" @@ -386,9 +386,9 @@ budgetReportAsTable _ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage Nothing where - costedAmounts = case cost_ of - Cost -> amounts . mixedAmountCost - NoCost -> amounts + costedAmounts = case conversionop_ of + Just ToCost -> amounts . mixedAmountCost + _ -> amounts -- | Calculate the percentage of actual change to budget goal for a particular commodity percentage' :: Change -> BudgetGoal -> CommoditySymbol -> Maybe Percentage diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 0babc1e4e..69581135b 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -36,7 +36,7 @@ type EntriesReportItem = Transaction entriesReport :: ReportSpec -> Journal -> EntriesReport entriesReport rspec@ReportSpec{_rsReportOpts=ropts} = sortBy (comparing $ transactionDateFn ropts) . jtxns - . journalApplyValuationFromOpts rspec{_rsReportOpts=ropts{show_costs_=True}} + . journalApplyValuationFromOpts (setDefaultConversionOp NoConversionOp rspec) . filterJournalTransactions (_rsQuery rspec) tests_EntriesReport = testGroup "EntriesReport" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 24f122365..dccca4397 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -257,7 +257,7 @@ getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle where rspec' = rspec{_rsQuery=depthless, _rsReportOpts = ropts'} ropts' = if isJust (valuationAfterSum ropts) - then ropts{value_=Nothing, cost_=NoCost} -- If we're valuing after the sum, don't do it now + then ropts{value_=Nothing, conversionop_=Just NoConversionOp} -- If we're valuing after the sum, don't do it now else ropts -- The user's query with no depth limit, and expanded to the report span @@ -432,7 +432,7 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} valuedaccts balance = maybeStripPrices . case accountlistmode_ ropts of ALTree | d == depth -> aibalance _ -> aebalance - where maybeStripPrices = if show_costs_ ropts then id else mixedAmountStripPrices + where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripPrices -- Accounts interesting because they are a fork for interesting subaccounts interestingParents = dbg5 "interestingParents" $ case accountlistmode_ ropts of diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index c92fbde36..cac15b6e6 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -30,6 +30,7 @@ module Hledger.Reports.ReportOptions ( defreportopts, rawOptsToReportOpts, defreportspec, + setDefaultConversionOp, reportOptsToSpec, updateReportSpec, updateReportSpecWith, @@ -69,7 +70,7 @@ import Data.Either (fromRight) import Data.Either.Extra (eitherToMaybe) import Data.Functor.Identity (Identity(..)) import Data.List.Extra (find, isPrefixOf, nubSort) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) @@ -124,7 +125,7 @@ data ReportOpts = ReportOpts { period_ :: Period ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched - ,cost_ :: Costing -- ^ Should we convert amounts to cost, when present? + ,conversionop_ :: Maybe ConversionOp -- ^ Which operation should we apply to conversion transactions? ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ? ,infer_prices_ :: Bool -- ^ Infer market prices from transactions ? ,depth_ :: Maybe Int @@ -180,7 +181,7 @@ defreportopts = ReportOpts { period_ = PeriodAll , interval_ = NoInterval , statuses_ = [] - , cost_ = NoCost + , conversionop_ = Nothing , value_ = Nothing , infer_prices_ = False , depth_ = Nothing @@ -223,7 +224,6 @@ rawOptsToReportOpts d rawopts = let formatstring = T.pack <$> maybestringopt "format" rawopts querystring = map T.pack $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right - (costing, valuation) = valuationTypeFromRawOpts rawopts pretty = fromMaybe False $ alwaysneveropt "pretty" rawopts format = case parseStringFormat <$> formatstring of @@ -235,8 +235,8 @@ rawOptsToReportOpts d rawopts = {period_ = periodFromRawOpts d rawopts ,interval_ = intervalFromRawOpts rawopts ,statuses_ = statusesFromRawOpts rawopts - ,cost_ = costing - ,value_ = valuation + ,conversionop_ = conversionOpFromRawOpts rawopts + ,value_ = valuationTypeFromRawOpts rawopts ,infer_prices_ = boolopt "infer-market-prices" rawopts ,depth_ = maybeposintopt "depth" rawopts ,date2_ = boolopt "date2" rawopts @@ -290,6 +290,11 @@ defreportspec = ReportSpec , _rsQueryOpts = [] } +-- | Set the default ConversionOp. +setDefaultConversionOp :: ConversionOp -> ReportSpec -> ReportSpec +setDefaultConversionOp def rspec@ReportSpec{_rsReportOpts=ropts} = + rspec{_rsReportOpts=ropts{conversionop_=conversionop_ ropts <|> Just def}} + accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt = fromMaybe ALFlat . choiceopt parse where @@ -469,39 +474,32 @@ reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss} | s `elem` ss = ropts{statuses_=filter (/= s) ss} | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} --- | Parse the type of valuation and costing to be performed, if any, --- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is --- allowed to combine -B/--cost with any other valuation type. If --- there's more than one valuation type, the rightmost flag wins. --- This will fail with a usage error if an invalid argument is passed --- to --value, or if --valuechange is called with a valuation type --- other than -V/--value=end. -valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType) -valuationTypeFromRawOpts rawopts = case (balancecalcopt rawopts, directcost, directval) of - (CalcValueChange, _, Nothing ) -> (directcost, Just $ AtEnd Nothing) -- If no valuation requested for valuechange, use AtEnd - (CalcValueChange, _, Just (AtEnd _)) -> (directcost, directval) -- If AtEnd valuation requested, use it - (CalcValueChange, _, _ ) -> usageError "--valuechange only produces sensible results with --value=end" - (CalcGain, Cost, _ ) -> usageError "--gain cannot be combined with --cost" - (CalcGain, NoCost, Nothing ) -> (directcost, Just $ AtEnd Nothing) -- If no valuation requested for gain, use AtEnd - (_, _, _ ) -> (directcost, directval) -- Otherwise, use requested valuation +-- | Parse the type of valuation to be performed, if any, specified by -V, +-- -X/--exchange, or --value flags. If there's more than one valuation type, +-- the rightmost flag wins. This will fail with a usage error if an invalid +-- argument is passed to --value, or if --valuechange is called with a +-- valuation type other than -V/--value=end. +valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType +valuationTypeFromRawOpts rawopts = case (balancecalcopt rawopts, directval) of + (CalcValueChange, Nothing ) -> Just $ AtEnd Nothing -- If no valuation requested for valuechange, use AtEnd + (CalcValueChange, Just (AtEnd _)) -> directval -- If AtEnd valuation requested, use it + (CalcValueChange, _ ) -> usageError "--valuechange only produces sensible results with --value=end" + (CalcGain, Nothing ) -> Just $ AtEnd Nothing -- If no valuation requested for gain, use AtEnd + (_, _ ) -> directval -- Otherwise, use requested valuation where - directcost = if Cost `elem` map fst valuationopts then Cost else NoCost - directval = lastMay $ mapMaybe snd valuationopts - - valuationopts = collectopts valuationfromrawopt rawopts + directval = lastMay $ collectopts valuationfromrawopt rawopts valuationfromrawopt (n,v) -- option name, value - | n == "B" = Just (Cost, Nothing) -- keep supporting --value=cost for now - | n == "V" = Just (NoCost, Just $ AtEnd Nothing) - | n == "X" = Just (NoCost, Just $ AtEnd (Just $ T.pack v)) - | n == "value" = Just $ valueopt v + | n == "V" = Just $ AtEnd Nothing + | n == "X" = Just $ AtEnd (Just $ T.pack v) + | n == "value" = valueopt v | otherwise = Nothing valueopt v - | t `elem` ["cost","c"] = (Cost, AtEnd . Just <$> mc) -- keep supporting --value=cost,COMM for now - | t `elem` ["then" ,"t"] = (NoCost, Just $ AtThen mc) - | t `elem` ["end" ,"e"] = (NoCost, Just $ AtEnd mc) - | t `elem` ["now" ,"n"] = (NoCost, Just $ AtNow mc) + | t `elem` ["cost","c"] = AtEnd . Just <$> mc -- keep supporting --value=cost,COMM for now + | t `elem` ["then" ,"t"] = Just $ AtThen mc + | t `elem` ["end" ,"e"] = Just $ AtEnd mc + | t `elem` ["now" ,"n"] = Just $ AtNow mc | otherwise = case parsedateM t of - Just d -> (NoCost, Just $ AtDate d mc) + Just d -> Just $ AtDate d mc Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD" where -- parse --value's value: TYPE[,COMM] @@ -510,6 +508,22 @@ valuationTypeFromRawOpts rawopts = case (balancecalcopt rawopts, directcost, dir "" -> Nothing c -> Just $ T.pack c +-- | Parse the type of costing to be performed, if any, specified by -B/--cost +-- or --value flags. If there's more than one costing type, the rightmost flag +-- wins. This will fail with a usage error if an invalid argument is passed to +-- --cost or if a costing type is requested with --gain. +conversionOpFromRawOpts :: RawOpts -> Maybe ConversionOp +conversionOpFromRawOpts rawopts + | isJust costFlag && balancecalcopt rawopts == CalcGain = usageError "--gain cannot be combined with --cost" + | boolopt "infer-equity" rawopts = costFlag <|> Just InferEquity + | otherwise = costFlag + where + costFlag = lastMay $ collectopts conversionopfromrawopt rawopts + conversionopfromrawopt (n,v) -- option name, value + | n == "B" = Just ToCost + | n == "value", takeWhile (/=',') v `elem` ["cost", "c"] = Just ToCost -- keep supporting --value=cost for now + | otherwise = Nothing + -- | Select the Transaction date accessor based on --date2. transactionDateFn :: ReportOpts -> (Transaction -> Day) transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate @@ -578,9 +592,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo where valuation p = maybe id (mixedAmountApplyValuation priceoracle styles (periodEnd p) (_rsDay rspec) (postingDate p)) (value_ ropts) gain p = maybe id (mixedAmountApplyGain priceoracle styles (periodEnd p) (_rsDay rspec) (postingDate p)) (value_ ropts) - costing = case cost_ ropts of - Cost -> journalToCost - NoCost -> id + costing = journalToCost (fromMaybe NoConversionOp $ conversionop_ ropts) -- Find the end of the period containing this posting periodEnd = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate @@ -605,9 +617,10 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = where valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span) gain mc span = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span) - costing = case cost_ ropts of - Cost -> styleMixedAmount styles . mixedAmountCost - NoCost -> id + costing = case fromMaybe NoConversionOp $ conversionop_ ropts of + NoConversionOp -> id + InferEquity -> mixedAmountStripPrices + ToCost -> styleMixedAmount styles . mixedAmountCost styles = journalCommodityStyles j err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date" diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index c1cf2639f..0d9d21e0d 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -285,7 +285,7 @@ asHandle ui0@UIState{ VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPosition (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui - VtyEvent (EvKey (KChar 'B') []) -> continue $ regenerateScreens j d $ toggleCost ui + VtyEvent (EvKey (KChar 'B') []) -> continue $ regenerateScreens j d $ toggleConversionOp ui VtyEvent (EvKey (KChar 'V') []) -> continue $ regenerateScreens j d $ toggleValue ui VtyEvent (EvKey (KChar '0') []) -> continue $ regenerateScreens j d $ setDepth (Just 0) ui VtyEvent (EvKey (KChar '1') []) -> continue $ regenerateScreens j d $ setDepth (Just 1) ui @@ -395,4 +395,4 @@ asCenterAndContinue ui = do scrollSelectionToMiddle $ _asList $ aScreen ui continue ui -asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements \ No newline at end of file +asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 8d2c594f1..71ced2ad5 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -335,7 +335,7 @@ rsHandle ui@UIState{ rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f) -- display mode/query toggles - VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCost ui + VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleConversionOp ui VtyEvent (EvKey (KChar 'V') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleValue ui VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui VtyEvent (EvKey (KChar 't') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleTree ui @@ -420,4 +420,4 @@ rsCenterAndContinue ui = do scrollSelectionToMiddle $ rsList $ aScreen ui continue ui -rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements \ No newline at end of file +rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 6f86853e9..40d1fec6f 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -63,12 +63,10 @@ tsInit _ _ _ = error "init function called with wrong screen type, should not ha -- Render a transaction suitably for the transaction screen. showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text showTxn ropts rspec j t = - showTransactionOneLineAmounts - $ maybe id (transactionApplyValuation prices styles periodlast (_rsDay rspec)) (value_ ropts) - $ case cost_ ropts of - Cost -> transactionToCost styles t - NoCost -> t - -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real + showTransactionOneLineAmounts + $ maybe id (transactionApplyValuation prices styles periodlast (_rsDay rspec)) (value_ ropts) + $ maybe id (transactionToCost (journalConversionAccount j) styles) (conversionop_ ropts) t + -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real where prices = journalPriceOracle (infer_prices_ ropts) j styles = journalCommodityStyles j @@ -97,9 +95,9 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec -- XXX would like to shrink the editor to the size of the entry, -- so handler can more easily detect clicks below it - txneditor = - renderEditor (vBox . map txt) False $ - editorText TransactionEditor Nothing $ + txneditor = + renderEditor (vBox . map txt) False $ + editorText TransactionEditor Nothing $ showTxn ropts rspec j t toplabel = @@ -187,7 +185,7 @@ tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransaction -- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui -- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui -- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui - VtyEvent (EvKey (KChar 'B') []) -> continue . regenerateScreens j d $ toggleCost ui + VtyEvent (EvKey (KChar 'B') []) -> continue . regenerateScreens j d $ toggleConversionOp ui VtyEvent (EvKey (KChar 'V') []) -> continue . regenerateScreens j d $ toggleValue ui VtyEvent e | e `elem` moveUpEvents -> continue $ tsSelect iprev tprev ui diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index b8a082b70..0ec1c6145 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -97,11 +97,13 @@ toggleEmpty :: UIState -> UIState toggleEmpty = over empty__ not -- | Toggle between showing the primary amounts or costs. -toggleCost :: UIState -> UIState -toggleCost = over cost toggleCostMode +toggleConversionOp :: UIState -> UIState +toggleConversionOp = over conversionop toggleCostMode where - toggleCostMode Cost = NoCost - toggleCostMode NoCost = Cost + toggleCostMode Nothing = Just ToCost + toggleCostMode (Just NoConversionOp) = Just ToCost + toggleCostMode (Just InferEquity) = Just ToCost + toggleCostMode (Just ToCost) = Just NoConversionOp -- | Toggle between showing primary amounts or default valuation. toggleValue :: UIState -> UIState diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 466442d7a..81d615b23 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -181,6 +181,8 @@ reportflags = [ ,"'now': convert to current market value, in default valuation commodity or COMM" ,"YYYY-MM-DD: convert to market value on the given date, in default valuation commodity or COMM" ]) + ,flagNone ["infer-equity"] (setboolopt "infer-equity") + "in conversion transactions, replace costs (transaction prices) with equity postings, to keep the transactions balanced" -- history of this flag so far, lest we be confused: -- originally --infer-value diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 5fb521873..5be0b3ba9 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -652,9 +652,9 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ (_, Cumulative ) -> "Ending balances (cumulative)" (_, Historical) -> "Ending balances (historical)" valuationdesc = - (case cost_ of - Cost -> ", converted to cost" - NoCost -> "") + (case conversionop_ of + Just ToCost -> ", converted to cost" + _ -> "") <> (case value_ of Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) | changingValuation -> "" diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index 198c46601..38bafad34 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -48,9 +48,8 @@ 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 CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do let - today = _rsDay rspec -- show opening entry, closing entry, or (default) both ? (opening, closing) = case (boolopt "open" rawopts, boolopt "close" rawopts) of @@ -72,6 +71,9 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do (Nothing, Just o) -> (o, o) (Nothing, Nothing) -> (T.pack defclosingacct, T.pack defopeningacct) + ropts = (_rsReportOpts rspec'){balanceaccum_=Historical, accountlistmode_=ALFlat} + rspec = setDefaultConversionOp (if show_costs then NoConversionOp else InferEquity) rspec'{_rsReportOpts=ropts} + -- dates of the closing and opening transactions -- -- Close.md: @@ -90,7 +92,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do -- - `-e 2021`" -- q = _rsQuery rspec - yesterday = addDays (-1) today + yesterday = addDays (-1) $ _rsDay rspec yesterdayorjournalend = case journalLastDay False j of Just journalend -> max yesterday journalend Nothing -> yesterday @@ -100,12 +102,11 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do -- should we show the amount(s) on the equity posting(s) ? explicit = boolopt "explicit" rawopts + show_costs = boolopt "show-costs" rawopts -- the balances to close - ropts = (_rsReportOpts rspec){balanceaccum_=Historical, accountlistmode_=ALFlat} - rspec_ = rspec{_rsReportOpts=ropts} - (acctbals',_) = balanceReport rspec_ j - acctbals = map (\(a,_,_,b) -> (a, if show_costs_ ropts then b else mixedAmountStripPrices b)) acctbals' + (acctbals',_) = balanceReport rspec j + acctbals = map (\(a,_,_,b) -> (a, if show_costs then b else mixedAmountStripPrices b)) acctbals' totalamt = maSum $ map snd acctbals -- since balance assertion amounts are required to be exact, the diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 81ce90bd9..fabce5402 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -21,7 +21,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB -import Lens.Micro (_Just, has) +import Lens.Micro ((^.), _Just, has) import System.Console.CmdArgs.Explicit import Hledger @@ -37,6 +37,8 @@ printmode = hledgerCommandMode ("show the transaction whose description is most similar to "++arg++", and is most recent") ,flagNone ["explicit","x"] (setboolopt "explicit") "show all amounts explicitly" + ,flagNone ["show-costs"] (setboolopt "show-costs") + "show transaction prices even with conversion postings" ,flagNone ["new"] (setboolopt "new") "show only newer-dated transactions added in each file since last run" ,outputFormatFlag ["txt","csv","json","sql"] @@ -72,7 +74,8 @@ printEntries opts@CliOpts{reportspec_=rspec} j = | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL: entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text -entriesReportAsText opts = TB.toLazyText . foldMap (TB.fromText . showTransaction . whichtxn) +entriesReportAsText opts = + TB.toLazyText . foldMap (TB.fromText . showTransaction . maybeStripPrices . whichtxn) where whichtxn -- With -x, use the fully-inferred txn with all amounts & txn prices explicit. @@ -84,6 +87,11 @@ entriesReportAsText opts = TB.toLazyText . foldMap (TB.fromText . showTransactio | 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 option is set + | opts ^. conversionop == Just InferEquity && not (boolopt "show-costs" $ rawopts_ opts) = + 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/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index ee1a49276..a69dd3dc8 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -66,7 +66,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO styles = journalCommodityStyles j mixedAmountValue periodlast date = maybe id (mixedAmountApplyValuation priceOracle styles periodlast today date) value_ - . mixedAmountToCost cost_ styles + . maybe id (mixedAmountToCost styles) conversionop_ let ropts = _rsReportOpts rspec diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 796b0a1f9..25cd66e15 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -152,9 +152,9 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r _ -> Nothing valuationdesc = - (case cost_ of - Cost -> ", converted to cost" - NoCost -> "") + (case conversionop_ of + Just ToCost -> ", converted to cost" + _ -> "") <> (case value_ of Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) | changingValuation -> "" diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 2cea166a5..69a0dc778 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -917,15 +917,22 @@ see the discussion at [#1625](https://github.com/simonmichael/hledger/issues/162 # COSTING -The `-B/--cost` flag converts amounts to their cost or sale amount at transaction time, -if they have a [transaction price](#transaction-prices) specified. -If this flag is supplied, hledger will perform cost conversion first, and will apply -any market price valuations (if requested) afterwards. +The `-B/--cost` flag converts amounts to their cost or sale amount at +transaction time, if they have a [transaction price](#transaction-prices) +specified. + +The `--infer-equity` flag generates conversion postings within equity to +balance any transaction prices. +The account used is "equity:conversion" by default, but this can be customised +with an account declaration: `account Conversion`. + +If either of these flags are supplied, hledger will perform cost conversion +first, and will apply any market price valuations (if requested) afterwards. + # VALUATION -Instead of reporting amounts in their original commodity, -hledger can convert them to +Instead of reporting amounts in their original commodity, hledger can convert them to cost/sale amount (using the conversion rate recorded in the transaction), and/or to market value (using some market price on a certain date). This is controlled by the `--value=TYPE[,COMMODITY]` option, which will be described below. @@ -2914,8 +2921,8 @@ account ACCTNAME [ACCTTYPE] [;COMMENT] By adding a `type` tag to the [account directive], with value -`A`, `L`, `E`, `R`, `X`, `C` -(or if you prefer: `Asset`, `Liability`, `Equity`, `Revenue`, `Expense`, `Cash`), +`A`, `L`, `E`, `R`, `X`, `C`, `V` +(or if you prefer: `Asset`, `Liability`, `Equity`, `Revenue`, `Expense`, `Cash`, `Conversion`), you can declare hledger accounts to be of a certain type: - **asset**, @@ -2928,6 +2935,9 @@ you can declare hledger accounts to be of a certain type: - **cash**\ a subtype of asset, used for [liquid assets][CCE]. +- **conversion**\ + a subtype of equity, used for [conversion postings](#costing) + Declaring account types is a good idea, since it helps enable the easy [balancesheet], [balancesheetequity], [incomestatement] and [cashflow] reports, and probably other things in future. diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index dbbd96f48..7b7f3061d 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -25,7 +25,50 @@ hledger -f- print --explicit --cost >>>=0 -# 3. print a transaction with a total price +# 3. --infer-equity generates conversion postings +hledger -f- print --infer-equity +<<< +2011/01/01 + expenses:foreign currency €100 @ $1.35 + assets +>>> +2011-01-01 + expenses:foreign currency €100 ; cost: @ $1.35 + equity:conversion:$-€:€ €-100 ; generated-posting: + equity:conversion:$-€:$ $135.00 ; generated-posting: + assets + +>>>=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 +>>> +2011-01-01 + expenses:foreign currency $135.00 + assets $-135.00 + +>>>=0 + +# 6. print a transaction with a total price hledger -f - print --explicit <<< 2011/01/01 @@ -38,7 +81,7 @@ hledger -f - print --explicit >>>=0 -# 4. when the balance has exactly two commodities, both unpriced, infer an +# 7. 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 <<< @@ -60,7 +103,7 @@ hledger -f - print --explicit >>>=0 -## 5. another, from ledger tests. Just one posting to price so uses @@. +# 8. another, from ledger tests. Just one posting to price so uses @@. hledger -f - print --explicit <<< 2002/09/30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be @@ -73,7 +116,7 @@ hledger -f - print --explicit >>>=0 -# 6. when the balance has more than two commodities, don't bother +# 9. when the balance has more than two commodities, don't bother hledger -f - print <<< 2011/01/01 @@ -82,7 +125,7 @@ hledger -f - print expenses:other £200 >>>= !0 -# 7. another +# 10. another hledger -f - balance -B <<< 2011/01/01 @@ -97,7 +140,7 @@ hledger -f - balance -B 0 >>>=0 -# 8. transaction in two commodities should balance out properly +# 11. transaction in two commodities should balance out properly hledger -f - balance --cost <<< 2011/01/01 x @@ -110,23 +153,62 @@ hledger -f - balance --cost 0 >>>=0 -# 9. 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) +# 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 +>>> + 16$ a + -16$ b +-------------------- + 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 +>>> + 10£ a + -16$ b + 16$ equity:conversion:$-£:$ + -10£ equity:conversion:$-£:£ +-------------------- + 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 +>>> + 10£ a + -16$ b +-------------------- + -16$ + 10£ +>>>=0 + +# 15. 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$ >>> -10£ a 16$ b --------------------- - 16$ - -10£ >>>=0 -# 10. Should not infer prices when --strict is specified +# 16. Should not infer prices when --strict is specified hledger -f - balance --strict <<< 2011/01/01 x @@ -135,7 +217,7 @@ hledger -f - balance --strict >>> >>>=1 -# 11. When commodity price is specified implicitly, transaction should +# 17. When commodity price is specified implicitly, transaction should # NOT be considered balanced out when BOTH amounts are negative hledger -f - balance <<< @@ -145,7 +227,7 @@ hledger -f - balance >>> >>>=1 -# 12. Differently-priced lots of a commodity should be merged in balance report +# 18. Differently-priced lots of a commodity should be merged in balance report hledger -f - balance <<< 2011/1/1 @@ -159,7 +241,7 @@ hledger -f - balance £2 >>>=0 -# 13. this should balance +# 19. this should balance hledger -f - balance <<< 2011/1/1 @@ -168,7 +250,7 @@ hledger -f - balance c $-30 >>>= 0 -# 14. these balance because of the unit prices, and should parse successfully +# 20. these balance because of the unit prices, and should parse successfully hledger -f - balance --no-total <<< 1/1 @@ -178,7 +260,7 @@ hledger -f - balance --no-total -1X a >>>= 0 -# 15. +# 21. hledger -f - balance --no-total -B <<< 1/1 @@ -187,7 +269,7 @@ hledger -f - balance --no-total -B >>> >>>= 0 -# 16. likewise with total prices. Note how the primary amount's sign is used. +# 22. likewise with total prices. Note how the primary amount's sign is used. hledger -f - balance --no-total <<< 1/1 @@ -197,7 +279,7 @@ hledger -f - balance --no-total -1X a >>>= 0 -# 17. +# 23. hledger -f - balance --no-total -B <<< 1/1 @@ -206,7 +288,7 @@ hledger -f - balance --no-total -B >>> >>>= 0 -# 18. here, a's primary amount is 0, and its cost is 1Y; b is the assigned auto-balancing amount of -1Y (per issue 69) +# 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 <<< 1/1 @@ -219,7 +301,7 @@ hledger -f - balance --no-total -E -1Y b >>>= 0 -# 19. Without -E, a should be hidden because its balance is zero, even though it has a non-zero cost. +# 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 @@ -231,7 +313,7 @@ hledger -f - balance --no-total -1Y b >>>= 0 -# 20. the above with -B +# 26. the above with -B hledger -f - balance --no-total -E -B <<< 1/1 @@ -244,6 +326,23 @@ hledger -f - balance --no-total -E -B -1Y b >>>= 0 +# 27. The equity account used by --infer-equity can be customised +hledger -f- print --infer-equity +<<< +account equity:trades V + +2011/01/01 + expenses:foreign currency €100 @ $1.35 + assets +>>> +2011-01-01 + expenses:foreign currency €100 ; cost: @ $1.35 + equity:trades:$-€:€ €-100 ; generated-posting: + equity:trades:$-€:$ $135.00 ; generated-posting: + assets + +>>>=0 + # # when the *cost-basis* balance has exactly two commodities, both # # unpriced, infer an implicit conversion price for the first one in terms # # of the second.