diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index e199d61f4..e48554d62 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -615,7 +615,7 @@ mapMixedAmount f (Mixed as) = Mixed $ map f as -- | Convert all component amounts to cost/selling price where -- possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount -mixedAmountCost (Mixed as) = Mixed $ map amountCost as +mixedAmountCost = mapMixedAmount amountCost -- | Divide a mixed amount's quantities by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount @@ -671,7 +671,7 @@ mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPrice -- | Given a map of standard commodity display styles, apply the -- appropriate one to each individual amount. styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as +styleMixedAmount styles = mapMixedAmount (styleAmount styles) -- | Reset each individual amount's display style to the default. mixedAmountUnstyled :: MixedAmount -> MixedAmount @@ -842,20 +842,20 @@ ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount) -- | Set the display precision in the amount's commodities. setMixedAmountPrecision :: AmountPrecision -> MixedAmount -> MixedAmount -setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as +setMixedAmountPrecision p = mapMixedAmount (setAmountPrecision p) mixedAmountStripPrices :: MixedAmount -> MixedAmount -mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=Nothing}) as +mixedAmountStripPrices = mapMixedAmount (\a -> a{aprice=Nothing}) -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount -canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as +canonicaliseMixedAmount styles = mapMixedAmount (canonicaliseAmount styles) -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. -- Does Decimal division, might be some rounding/irrational number issues. mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount -mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnitPrice as +mixedAmountTotalPriceToUnitPrice = mapMixedAmount amountTotalPriceToUnitPrice ------------------------------------------------------------------------------- diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 581536790..6833f77d4 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -64,6 +64,7 @@ module Hledger.Data.Posting ( -- * misc. showComment, postingTransformAmount, + postingApplyCostValuation, postingApplyValuation, postingToCost, tests_Posting @@ -330,17 +331,24 @@ aliasReplace (BasicAlias old new) a aliasReplace (RegexAlias re repl) a = fmap T.pack . regexReplace re repl $ T.unpack a -- XXX +-- | Apply a specified costing and valuation to this posting's amount, +-- using the provided price oracle, commodity styles, and reference dates. +-- Costing is done first if requested, and after that any valuation. +-- See amountApplyValuation and amountCost. +postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting +postingApplyCostValuation priceoracle styles periodlast today cost v p = + postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p + -- | Apply a specified valuation to this posting's amount, using the --- provided price oracle, commodity styles, reference dates, and --- whether this is for a multiperiod report or not. See --- amountApplyValuation. +-- provided price oracle, commodity styles, and reference dates. +-- See amountApplyValuation. postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Posting -> Posting 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 p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a} +postingToCost styles = postingTransformAmount (styleMixedAmount styles . mixedAmountCost) -- | 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 95ab27cc4..40927ccdc 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -32,6 +32,7 @@ module Hledger.Data.Transaction ( balanceTransaction, balanceTransactionHelper, transactionTransformPostings, + transactionApplyCostValuation, transactionApplyValuation, transactionToCost, transactionApplyAliases, @@ -590,10 +591,16 @@ postingSetTransaction t p = p{ptransaction=Just t} transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} +-- | Apply a specified costing and valuation to this transaction's amounts, +-- using the provided price oracle, commodity styles, and reference dates. +-- See amountApplyValuation and amountCost. +transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction +transactionApplyCostValuation priceoracle styles periodlast today cost v = + transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v) + -- | Apply a specified valuation to this transaction's amounts, using --- the provided price oracle, commodity styles, reference dates, and --- whether this is for a multiperiod report or not. See --- amountApplyValuation. +-- the provided price oracle, commodity styles, and reference dates. +-- See amountApplyValuation. transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction transactionApplyValuation priceoracle styles periodlast today v = transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v) diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 073c8d84e..cb61bba37 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -13,11 +13,13 @@ looking up historical market prices (exchange rates) between commodities. {-# LANGUAGE DeriveGeneric #-} module Hledger.Data.Valuation ( - ValuationType(..) + Costing(..) + ,ValuationType(..) ,PriceOracle ,journalPriceOracle -- ,amountApplyValuation -- ,amountValueAtDate + ,mixedAmountApplyCostValuation ,mixedAmountApplyValuation ,mixedAmountValueAtDate ,marketPriceReverse @@ -51,11 +53,14 @@ import Text.Printf (printf) ------------------------------------------------------------------------------ -- Types +-- | Whether to convert amounts to cost. +data Costing = Cost | NoCost + deriving (Show,Eq) + -- | What kind of value conversion should be done on amounts ? --- CLI: --value=cost|then|end|now|DATE[,COMM] +-- CLI: --value=then|end|now|DATE[,COMM] data ValuationType = - AtCost (Maybe CommoditySymbol) -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date - | AtThen (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at each posting's date + AtThen (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at each posting's date | AtEnd (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at period end(s) | AtNow (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using current market prices | AtDate Day (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices on some date @@ -94,9 +99,21 @@ priceDirectiveToMarketPrice PriceDirective{..} = ------------------------------------------------------------------------------ -- Converting things to value +-- | Apply a specified costing and valuation to this mixed amount, +-- using the provided price oracle, commodity styles, and reference dates. +-- Costing is done first if requested, and after that any valuation. +-- See amountApplyValuation and amountCost. +mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount +mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v = + valuation . costing + where + valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v + costing = case cost of + Cost -> styleMixedAmount styles . mixedAmountCost + NoCost -> id + -- | Apply a specified valuation to this mixed amount, using the --- provided price oracle, commodity styles, reference dates, and --- whether this is for a multiperiod report or not. +-- provided price oracle, commodity styles, and reference dates. -- See amountApplyValuation. mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = @@ -114,7 +131,7 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = -- -- - a fixed date specified by the ValuationType itself -- (--value=DATE). --- +-- -- - the provided "period end" date - this is typically the last day -- of a subperiod (--value=end with a multi-period report), or of -- the specified report period or the journal (--value=end with a @@ -133,8 +150,6 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> Amount -> Amount amountApplyValuation priceoracle styles periodlast today postingdate v a = case v of - AtCost Nothing -> styleAmount styles $ amountCost a - AtCost mc -> amountValueAtDate priceoracle styles mc periodlast . styleAmount styles $ amountCost a AtThen mc -> amountValueAtDate priceoracle styles mc postingdate a AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a AtNow mc -> amountValueAtDate priceoracle styles mc today a diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index d2cf07235..6b9c531ba 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -111,7 +111,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i periodlast = fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen reportPeriodOrJournalLastDay rspec j - tval = maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) $ value_ ropts + tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) $ value_ ropts ts4 = ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ map tval ts3 diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index fd2e98738..1081ab4ee 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -226,8 +226,10 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ (textCell TopLeft) (textCell TopRight) (uncurry showcell) displayTableWithWidths where title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr) + <> (case cost_ of + Cost -> ", converted to cost" + NoCost -> "") <> (case value_ of - Just (AtCost _mc) -> ", valued at cost" Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" @@ -284,9 +286,9 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ _ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage Nothing where - maybecost = case value_ of - Just (AtCost _) -> mixedAmountCost - _ -> id + maybecost = case cost_ of + Cost -> mixedAmountCost + NoCost -> id maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index ef2259502..9da872834 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -40,11 +40,8 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} = -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} where - pvalue = maybe id - (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec)) - value_ - where - periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j + pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_ + where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 1ab60700d..7bb2b0cd2 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -50,7 +50,7 @@ import Data.Semigroup ((<>)) #endif import Data.Semigroup (sconcat) import Data.Time.Calendar (Day, addDays, fromGregorian) -import Safe (headMay, lastDef, lastMay, minimumMay) +import Safe (headMay, lastDef, lastMay) import Hledger.Data import Hledger.Query @@ -317,14 +317,13 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col CumulativeChange -> cumulative HistoricalBalance -> historical where - historical = cumulativeSum avalue startingBalance changes - cumulative | changingValuation ropts = fmap (`subtractAcct` valuedStart) historical - | otherwise = cumulativeSum avalue nullacct changes - changeamts | changingValuation ropts = periodChanges valuedStart historical - | otherwise = changes + historical = cumulativeSum avalue startingBalance changes + cumulative = cumulativeSum avalue nullacct changes + changeamts = if changingValuation ropts + then periodChanges nullacct cumulative + else changes startingBalance = HM.lookupDefault nullacct name startbals - valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance -- Transpose to get each account's balance changes across all columns, then -- pad with zeros @@ -335,7 +334,6 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col (pvalue, avalue) = postingAndAccountValuations rspec j priceoracle addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id - historicalDate = minimumMay $ mapMaybe spanStart colspans zeros = M.fromList [(span, nullacct) | span <- colspans] colspans = M.keys colps @@ -576,14 +574,13 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start -- MultiBalanceReport. postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle -> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account) -postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle = - case value_ ropts of - Nothing -> (const id, const id) - Just v -> if changingValuation ropts then (const id, avalue' v) else (pvalue' v, const id) +postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle + | changingValuation ropts = (const id, avalue' (cost_ ropts) (value_ ropts)) + | otherwise = (pvalue' (cost_ ropts) (value_ ropts), const id) where - avalue' v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)} - where value = mixedAmountApplyValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") v -- PARTIAL: should not happen - pvalue' v span = postingApplyValuation priceoracle styles (end span) (rsToday rspec) v + avalue' c v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)} + where value = mixedAmountApplyCostValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") c v -- PARTIAL: should not happen + pvalue' c v span = postingApplyCostValuation priceoracle styles (end span) (rsToday rspec) c v end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date") -- XXX should not happen . fmap (addDays (-1)) . spanEnd styles = journalCommodityStyles j diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 073757e46..715f62f4a 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -76,7 +76,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". - pvalue periodlast = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_ + pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_ -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Day)] diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index e127d26db..486efae1f 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -45,7 +45,7 @@ where import Control.Applicative ((<|>)) import Data.List.Extra (nubSort) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) @@ -85,6 +85,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? ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ? ,infer_value_ :: Bool -- ^ Infer market prices from transactions ? ,depth_ :: Maybe Int @@ -134,6 +135,7 @@ defreportopts = ReportOpts { period_ = PeriodAll , interval_ = NoInterval , statuses_ = [] + , cost_ = NoCost , value_ = Nothing , infer_value_ = False , depth_ = Nothing @@ -170,6 +172,7 @@ rawOptsToReportOpts rawopts = do let colorflag = stringopt "color" rawopts formatstring = T.pack <$> maybestringopt "format" rawopts querystring = map T.pack $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right + (costing, valuation) = valuationTypeFromRawOpts rawopts format <- case parseStringFormat <$> formatstring of Nothing -> return defaultBalanceLineFormat @@ -180,7 +183,8 @@ rawOptsToReportOpts rawopts = do {period_ = periodFromRawOpts d rawopts ,interval_ = intervalFromRawOpts rawopts ,statuses_ = statusesFromRawOpts rawopts - ,value_ = valuationTypeFromRawOpts rawopts + ,cost_ = costing + ,value_ = valuation ,infer_value_ = boolopt "infer-value" rawopts ,depth_ = maybeposintopt "depth" rawopts ,date2_ = boolopt "date2" rawopts @@ -400,27 +404,29 @@ 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 to be performed, if any, specified by --- -B/--cost, -V, -X/--exchange, or --value flags. If there's more --- than one of these, the rightmost flag wins. -valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType -valuationTypeFromRawOpts = lastMay . collectopts valuationfromrawopt +-- | 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. +valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType) +valuationTypeFromRawOpts rawopts = (costing, lastMay $ mapMaybe snd valuationopts) where + costing = if (any ((Cost==) . fst) valuationopts) then Cost else NoCost + valuationopts = collectopts valuationfromrawopt rawopts valuationfromrawopt (n,v) -- option name, value - | n == "B" = Just $ AtCost Nothing - | n == "V" = Just $ AtEnd Nothing - | n == "X" = Just $ AtEnd (Just $ T.pack v) + | n == "B" = Just (Cost, Nothing) + | n == "V" = Just (NoCost, Just $ AtEnd Nothing) + | n == "X" = Just (NoCost, Just $ AtEnd (Just $ T.pack v)) | n == "value" = Just $ valuation v | otherwise = Nothing valuation v - | t `elem` ["cost","c"] = AtCost mc - | t `elem` ["then" ,"t"] = AtThen mc - | t `elem` ["end" ,"e"] = AtEnd mc - | t `elem` ["now" ,"n"] = AtNow mc - | otherwise = - case parsedateM t of - Just d -> AtDate d mc - Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD" + | t `elem` ["cost","c"] = (Cost, usageError "--value=cost,COMM is no longer supported, please specify valuation explicitly, e.g. --cost --value=then,COMM" <$ mc) + | t `elem` ["then" ,"t"] = (NoCost, Just $ AtThen mc) + | t `elem` ["end" ,"e"] = (NoCost, Just $ AtEnd mc) + | t `elem` ["now" ,"n"] = (NoCost, Just $ AtNow mc) + | otherwise = case parsedateM t of + Just d -> (NoCost, 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] (t,c') = break (==',') v @@ -452,13 +458,12 @@ flat_ = not . tree_ -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) -- | Convert this journal's postings' amounts to cost using their --- transaction prices, if specified by options (-B/--value=cost). +-- transaction prices, if specified by options (-B/--cost). -- Maybe soon superseded by newer valuation code. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal -journalSelectingAmountFromOpts opts = - case value_ opts of - Just (AtCost _) -> journalToCost - _ -> id +journalSelectingAmountFromOpts opts = case cost_ opts of + Cost -> journalToCost + NoCost -> id -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromFlags :: ReportOpts -> Query @@ -476,7 +481,6 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq -- different report periods. changingValuation :: ReportOpts -> Bool changingValuation ropts = case value_ ropts of - Just (AtCost (Just _)) -> True Just (AtEnd _) -> True _ -> False diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 5e12ef8bf..889043cf3 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -81,7 +81,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{ render . defaultLayout toplabel bottomlabel . str . T.unpack . showTransactionOneLineAmounts - $ maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts) t + $ transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) (value_ ropts) t -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real where toplabel = diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 7e05a4858..7e40a3dda 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -113,7 +113,10 @@ clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_= -- | Toggle between showing the primary amounts or costs. toggleCost :: UIState -> UIState toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{value_ = valuationToggleCost $ value_ ropts}}}}} + ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{cost_ = toggle $ cost_ ropts}}}}} + where + toggle Cost = NoCost + toggle NoCost = Cost -- | Toggle between showing primary amounts or default valuation. toggleValue :: UIState -> UIState @@ -121,11 +124,6 @@ toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rsp ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{ value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}}} --- | Basic toggling of -B/cost, for hledger-ui. -valuationToggleCost :: Maybe ValuationType -> Maybe ValuationType -valuationToggleCost (Just (AtCost _)) = Nothing -valuationToggleCost _ = Just $ AtCost Nothing - -- | Basic toggling of -V, for hledger-ui. valuationToggleValue :: Maybe ValuationType -> Maybe ValuationType valuationToggleValue (Just (AtEnd _)) = Nothing diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index ef8031b97..4de85b284 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -156,7 +156,7 @@ reportflags = [ -- valuation ,flagNone ["B","cost"] (setboolopt "B") - "show amounts converted to their cost/selling amount, using the transaction price. Equivalent to --value=cost." + "show amounts converted to their cost/selling amount, using the transaction price." ,flagNone ["V","market"] (setboolopt "V") (unwords ["show amounts converted to period-end market value in their default valuation commodity." @@ -166,12 +166,11 @@ reportflags = [ (unwords ["show amounts converted to current (single period reports)" ,"or period-end (multiperiod reports) market value in the specified commodity." - ,"Equivalent to --value=now,COMM / --value=end,COMM." + ,"Equivalent to --value=end,COMM." ]) ,flagReq ["value"] (\s opts -> Right $ setopt "value" s opts) "TYPE[,COMM]" (unlines ["show amounts converted with valuation TYPE, and optionally to specified commodity COMM. TYPE can be:" - ,"'cost': convert to cost using transaction prices, then optionally to COMM using period-end market prices" ,"'then': convert to contemporaneous market value, in default valuation commodity or COMM (print & register commands only)" ,"'end': convert to period-end market value, in default valuation commodity or COMM" ,"'now': convert to current market value, in default valuation commodity or COMM" diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 5f2b3870f..8d9b4f9d1 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -598,14 +598,17 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ PeriodChange -> "Balance changes" CumulativeChange -> "Ending balances (cumulative)" HistoricalBalance -> "Ending balances (historical)" - valuationdesc = case value_ of - Just (AtCost _mc) -> ", valued at cost" - Just (AtThen _mc) -> ", valued at posting date" - Just (AtEnd _mc) | changingValuation -> "" - Just (AtEnd _mc) -> ", valued at period ends" - Just (AtNow _mc) -> ", current value" - Just (AtDate d _mc) -> ", valued at " <> showDate d - Nothing -> "" + valuationdesc = + (case cost_ of + Cost -> ", converted to cost" + NoCost -> "") + <> (case value_ of + Just (AtThen _mc) -> ", valued at posting date" + Just (AtEnd _mc) | changingValuation -> "" + Just (AtEnd _mc) -> ", valued at period ends" + Just (AtNow _mc) -> ", current value" + Just (AtDate d _mc) -> ", valued at " <> showDate d + Nothing -> "") changingValuation = case (balancetype_, value_) of (PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index ba6b806da..449af8adf 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -61,13 +61,8 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..} d <- getCurrentDay -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". let - tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} - where - pvalue = maybe id - (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec)) - value_ - where - periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j + tvalue = transactionApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_ + where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j let ropts = rsOpts rspec showCashFlow = boolopt "cashflow" rawopts @@ -278,7 +273,7 @@ unMix a = Just a -> aquantity a Nothing -> error' $ "Amounts could not be converted to a single cost basis: " ++ show (map showAmount $ amounts a) ++ "\nConsider using --value to force all costs to be in a single commodity." ++ - "\nFor example, \"--value cost, --infer-value\", where commodity is the one that was used to pay for the investment." + "\nFor example, \"--cost --value=end, --infer-value\", where commodity is the one that was used to pay for the investment." -- Show Decimal rounded to two decimal places, unless it has less places already. This ensures that "2" won't be shown as "2.00" showDecimal :: Decimal -> String diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 04b3950c4..1412bf39a 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -139,14 +139,17 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r CumulativeChange -> "(Cumulative Ending Balances)" HistoricalBalance -> "(Historical Ending Balances)" - valuationdesc = case value_ of - Just (AtCost _mc) -> ", valued at cost" - Just (AtThen _mc) -> ", valued at posting date" - Just (AtEnd _mc) | changingValuation -> "" - Just (AtEnd _mc) -> ", valued at period ends" - Just (AtNow _mc) -> ", current value" - Just (AtDate today _mc) -> ", valued at " <> showDate today - Nothing -> "" + valuationdesc = + (case cost_ of + Cost -> ", converted to cost" + NoCost -> "") + <> (case value_ of + Just (AtThen _mc) -> ", valued at posting date" + Just (AtEnd _mc) | changingValuation -> "" + Just (AtEnd _mc) -> ", valued at period ends" + Just (AtNow _mc) -> ", current value" + Just (AtDate today _mc) -> ", valued at " <> showDate today + Nothing -> "") changingValuation = case (balancetype_, value_) of (PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 7e3790ca8..5baa0e0c0 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -716,26 +716,28 @@ Some of these can also be expressed as command-line options (eg `depth:2` is equ Generally you can mix options and query arguments, and the resulting query will be their intersection (perhaps excluding the `-p/--period` option). +# COSTING + +The `-B/--cost` flag converts amounts to their cost or sale amount at transaction time, +if they have a [transaction price](hledger.html#transaction-prices) specified. +If this flag is 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 cost/sale amount (using the conversion rate recorded in the transaction), -or to market value (using some market price on a certain date). -This is controlled by the `--value=TYPE[,COMMODITY]` option, -but we also provide the simpler `-B`/`-V`/`-X` flags, +and/or to market value (using some market price on a certain date). +This is controlled by the `--cost` and `--value=TYPE[,COMMODITY]` options, +but we also provide the simpler `-V`/`-X` flags, and usually one of those is all you need. -## -B: Cost - -The `-B/--cost` flag converts amounts to their cost or sale amount at transaction time, -if they have a [transaction price](hledger.html#transaction-prices) specified. - ## -V: Value The `-V/--market` flag converts amounts to market value in their default *valuation commodity*, using the -[market prices](#market-prices) in effect on the *valuation date(s)*, if any. +[market prices](#market-prices) in effect on the *valuation date(s)*, if any. More on these in a minute. ## -X: Value in specified commodity @@ -885,12 +887,11 @@ $ hledger -f t.j bal -N euros -V ## --value: Flexible valuation -`-B`, `-V` and `-X` are special cases of the more general `--value` option: +`-V` and `-X` are special cases of the more general `--value` option: - --value=TYPE[,COMM] TYPE is cost, then, end, now or YYYY-MM-DD. + --value=TYPE[,COMM] TYPE is then, end, now or YYYY-MM-DD. COMM is an optional commodity symbol. Shows amounts converted to: - - cost commodity using transaction prices (then optionally to COMM using market prices at period end(s)) - default valuation commodity (or COMM) using market prices at posting dates - default valuation commodity (or COMM) using market prices at period end(s) - default valuation commodity (or COMM) using current market prices @@ -898,9 +899,6 @@ $ hledger -f t.j bal -N euros -V The TYPE part selects cost or value and valuation date: -`--value=cost` -: Convert amounts to cost, using the prices recorded in transactions. - `--value=then` : Convert amounts to their value in the [default valuation commodity](#valuation-commodity), using market prices on each posting's date. @@ -945,7 +943,7 @@ P 2000-04-01 A 4 B Show the cost of each posting: ```shell -$ hledger -f- print --value=cost +$ hledger -f- print --cost 2000-01-01 (a) 5 B @@ -1056,7 +1054,7 @@ Related: [#329](https://github.com/simonmichael/hledger/issues/329), [#1083](https://github.com/simonmichael/hledger/issues/1083). -| Report type | `-B`, `--value=cost` | `-V`, `-X` | `--value=then` | `--value=end` | `--value=DATE`, `--value=now` | +| Report type | `-B`, `--cost` | `-V`, `-X` | `--value=then` | `--value=end` | `--value=DATE`, `--value=now` | |-----------------------------------------------------|------------------------------------------------------------------|-------------------------------------------------------------------|------------------------------------------------------------------------------------------------|-------------------------------------------------------------------|-----------------------------------------| | **print** | | | | | | | posting amounts | cost | value at report end or today | value at posting date | value at report or journal end | value at DATE/today | diff --git a/hledger/test/journal/valuation.test b/hledger/test/journal/valuation.test index b065c0c60..4088fae89 100644 --- a/hledger/test/journal/valuation.test +++ b/hledger/test/journal/valuation.test @@ -219,7 +219,7 @@ $ hledger -f- reg --value=cost 2000-01-01 (a) 6 B 6 B 2000-02-01 (a) 7 B 13 B 2000-03-01 (a) 8 B 21 B - + # 16. register report valued at posting dates $ hledger -f- reg --value=then 2000-01-01 (a) 1 B 1 B @@ -303,12 +303,16 @@ $ hledger -f- reg --value=cost -M # back to the original test journal: < +P 1999/01/01 A 10 B P 2000/01/01 A 1 B P 2000/01/15 A 5 B P 2000/02/01 A 2 B P 2000/03/01 A 3 B P 2000/04/01 A 4 B +1999/01/01 + (a) 2 A @ 4 B + 2000/01/01 (a) 1 A @ 6 B @@ -319,25 +323,25 @@ P 2000/04/01 A 4 B (a) 1 A @ 8 B # 25. periodic register report valued at period end -$ hledger -f- reg --value=end -M +$ hledger -f- reg --value=end -M -b 2000 2000-01 a 5 B 5 B 2000-02 a 2 B 7 B 2000-03 a 3 B 10 B # 26. periodic register report valued at specified date -$ hledger -f- reg --value=2000-01-15 -M +$ hledger -f- reg --value=2000-01-15 -M -b 2000 2000-01 a 5 B 5 B 2000-02 a 5 B 10 B 2000-03 a 5 B 15 B # 27. periodic register report valued today -$ hledger -f- reg --value=now -M +$ hledger -f- reg --value=now -M -b 2000 2000-01 a 4 B 4 B 2000-02 a 4 B 8 B 2000-03 a 4 B 12 B # 28. periodic register report valued at default date (same as --value=end) -$ hledger -f- reg -V -M +$ hledger -f- reg -V -M -b 2000 2000-01 a 5 B 5 B 2000-02 a 2 B 7 B 2000-03 a 3 B 10 B @@ -345,30 +349,30 @@ $ hledger -f- reg -V -M # balance # 29. single column balance report valued at cost -$ hledger -f- bal -N --value=cost +$ hledger -f- bal -N --value=cost -b 2000 21 B a # 30. single column balance report valued at period end (which includes market price declarations, see #1405) -$ hledger -f- bal -N --value=end +$ hledger -f- bal -N --value=end -b 2000 12 B a # 31. single column balance report valued at specified date -$ hledger -f- bal -N --value=2000-01-15 +$ hledger -f- bal -N --value=2000-01-15 -b 2000 15 B a # 32. single column balance report valued today -$ hledger -f- bal -N --value=now +$ hledger -f- bal -N --value=now -b 2000 12 B a # 33. single column balance report valued at default date (same as --value=end) -$ hledger -f- bal -N -V +$ hledger -f- bal -N -V -b 2000 12 B a # balance, periodic # 34. multicolumn balance report valued at cost -$ hledger -f- bal -MTA --value=cost -Balance changes in 2000-01-01..2000-04-30, valued at cost: +$ hledger -f- bal -MTA --value=cost -b 2000 +Balance changes in 2000-01-01..2000-04-30, converted to cost: || Jan Feb Mar Apr Total Average ===++====================================== @@ -377,7 +381,7 @@ Balance changes in 2000-01-01..2000-04-30, valued at cost: || 6 B 7 B 8 B 0 21 B 5 B # 35. multicolumn balance report valued at posting date -$ hledger -f- bal -M --value=then +$ hledger -f- bal -M --value=then -b 2000 Balance changes in 2000-01-01..2000-04-30, valued at posting date: || Jan Feb Mar Apr @@ -387,7 +391,7 @@ Balance changes in 2000-01-01..2000-04-30, valued at posting date: || 1 B 2 B 3 B 0 # 36. multicolumn balance report showing changes in period-end values -$ hledger -f- bal -M --value=end +$ hledger -f- bal -M --value=end -b 2000 Period-end value changes in 2000-01-01..2000-04-30: || Jan Feb Mar Apr @@ -397,7 +401,7 @@ Period-end value changes in 2000-01-01..2000-04-30: || 5 B -1 B 5 B 3 B # 37. multicolumn balance report showing changes in period-end values with -T or -A -$ hledger -f- bal -MTA --value=end +$ hledger -f- bal -MTA --value=end -b 2000 Period-end value changes in 2000-01-01..2000-04-30: || Jan Feb Mar Apr Total Average @@ -407,7 +411,7 @@ Period-end value changes in 2000-01-01..2000-04-30: || 5 B -1 B 5 B 3 B 12 B 3 B # 38. multicolumn balance report valued at other date -$ hledger -f- bal -MTA --value=2000-01-15 +$ hledger -f- bal -MTA --value=2000-01-15 -b 2000 Balance changes in 2000-01-01..2000-04-30, valued at 2000-01-15: || Jan Feb Mar Apr Total Average @@ -417,7 +421,7 @@ Balance changes in 2000-01-01..2000-04-30, valued at 2000-01-15: || 5 B 5 B 5 B 0 15 B 4 B # 39. multicolumn balance report valued today (with today >= 2000-04-01) -$ hledger -f- bal -M --value=now +$ hledger -f- bal -M --value=now -b 2000 Balance changes in 2000-01-01..2000-04-30, current value: || Jan Feb Mar Apr @@ -427,7 +431,7 @@ Balance changes in 2000-01-01..2000-04-30, current value: || 4 B 4 B 4 B 0 # 40. multicolumn balance report showing changes in period-end values (same as --value=end) -$ hledger -f- bal -M -V +$ hledger -f- bal -M -V -b 2000 Period-end value changes in 2000-01-01..2000-04-30: || Jan Feb Mar Apr @@ -439,42 +443,42 @@ Period-end value changes in 2000-01-01..2000-04-30: # balance, periodic, with -H (starting balance and accumulating across periods) # 41. multicolumn balance report with -H, valued at cost. -# The starting balance on 2000/01/01 is 6 B (cost of the first 2 A). -# February adds 1 A costing 7 B, making 13 B. -# March adds 1 A costing 8 B, making 21 B. +# The starting balance on 2000/01/01 is 14 B (cost of the first 8A). +# February adds 1 A costing 7 B, making 21 B. +# March adds 1 A costing 8 B, making 29 B. $ hledger -f- bal -M -H -b 200002 --value=cost -Ending balances (historical) in 2000-02-01..2000-04-30, valued at cost: +Ending balances (historical) in 2000-02-01..2000-04-30, converted to cost: || 2000-02-29 2000-03-31 2000-04-30 ===++==================================== - a || 13 B 21 B 21 B + a || 21 B 29 B 29 B ---++------------------------------------ - || 13 B 21 B 21 B + || 21 B 29 B 29 B # 42. multicolumn balance report with -H valued at period end. -# The starting balance is 1 A. -# February adds 1 A making 2 A, which is valued at 2000/02/29 as 4 B. -# March adds 1 A making 3 A, which is valued at 2000/03/31 as 9 B. -# April adds 0 A making 3 A, which is valued at 2000/04/31 as 12 B. +# The starting balance is 3 A. +# February adds 1 A making 4 A, which is valued at 2000/02/29 as 8 B. +# March adds 1 A making 5 A, which is valued at 2000/03/31 as 15 B. +# April adds 0 A making 5 A, which is valued at 2000/04/31 as 20 B. $ hledger -f- bal -MA -H -b 200002 --value=end Ending balances (historical) in 2000-02-01..2000-04-30, valued at period ends: || 2000-02-29 2000-03-31 2000-04-30 Average ===++============================================= - a || 4 B 9 B 12 B 8 B + a || 8 B 15 B 20 B 14 B ---++--------------------------------------------- - || 4 B 9 B 12 B 8 B + || 8 B 15 B 20 B 14 B # 43. multicolumn balance report with -H valued at other date. -# The starting balance is 5 B (1 A valued at 2000/1/15). +# The starting balance is 15 B (3 A valued at 2000/1/15). $ hledger -f- bal -M -H -b 200002 --value=2000-01-15 Ending balances (historical) in 2000-02-01..2000-04-30, valued at 2000-01-15: || 2000-02-29 2000-03-31 2000-04-30 ===++==================================== - a || 10 B 15 B 15 B + a || 20 B 25 B 25 B ---++------------------------------------ - || 10 B 15 B 15 B + || 20 B 25 B 25 B # 44. multicolumn balance report with -H, valuing each period's carried-over balances at cost. < @@ -488,7 +492,7 @@ P 2000/04/01 A 4 B (a) 1 A @ 6 B $ hledger -f- bal -ME -H -p200001-200004 --value=c -Ending balances (historical) in 2000Q1, valued at cost: +Ending balances (historical) in 2000Q1, converted to cost: || 2000-01-31 2000-02-29 2000-03-31 ===++==================================== @@ -551,7 +555,7 @@ Budget performance in 2000-01-01..2000-04-30: # 48. budget report, valued at cost. $ hledger -f- bal -MTA --budget --value=c -Budget performance in 2000-01-01..2000-04-30, valued at cost: +Budget performance in 2000-01-01..2000-04-30, converted to cost: || Jan Feb Mar Apr Total Average ===++=============================================================================================================== diff --git a/hledger/test/journal/valuation2.test b/hledger/test/journal/valuation2.test index 58548d9f6..a0ba8a319 100644 --- a/hledger/test/journal/valuation2.test +++ b/hledger/test/journal/valuation2.test @@ -134,11 +134,11 @@ $ hledger -f- print -B >=0 -# 12. Note the -XZ nullifies the -B here, because both are forms of --value -# (-B -XZ is equivalent to --value=cost --value=end,Z), and the rightmost wins. +# 12. Note the -XZ does not nullify the -B here. +# (-B -XZ is equivalent to --cost --value=end,Z). $ hledger -f- print -B -XZ 2000-01-01 - a -1A @ 1B + a -1B b 1B >=0 @@ -176,10 +176,10 @@ $ hledger -f- print -B >=0 # 16. -$ hledger -f- print -B -XZ +$ hledger -f- print -B -XA 2000-01-01 - a -1A @ 1B - b 1B + a -1A + b 1A >=0 diff --git a/hledger/test/roi.test b/hledger/test/roi.test index 3f7f56c47..af750f631 100644 --- a/hledger/test/roi.test +++ b/hledger/test/roi.test @@ -240,11 +240,11 @@ hledger -f- roi -p 2019-11 --inv Investment --pnl PnL >>>2 hledger: Amounts could not be converted to a single cost basis: ["10 B","-10 B @@ 100 A"] Consider using --value to force all costs to be in a single commodity. -For example, "--value cost, --infer-value", where commodity is the one that was used to pay for the investment. +For example, "--cost --value=end, --infer-value", where commodity is the one that was used to pay for the investment. >>>=1 # 10. Forcing valuation via --value -hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --value cost,A --infer-value +hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --cost --value=then,A --infer-value <<< 2019/11/01 Example Assets:Checking -100 A