From ebf5ed93f242c22a0cb5fc5281bf0ba60bce18bd Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 3 May 2019 12:24:02 -0700 Subject: [PATCH] valuation: more thorough --value-at; document status (#329, #999) This feature turns out to be quite involved, as valuation interacts with the many report variations. Various bugs/specs have been fixed/clarified relating to register's running total, balance totals etc. Eg register's total should now be the sum of the posting amount values, not the values of the original sums. Current level of support has been documented. When valuing at transaction date, we once again do early valuation of all posting amounts, to get more correct results. variants. This means --value-at=t can be slower than other valuation modes when there are many transactions and many prices. This could be revisited for optimisation when things are more settled. --- hledger-lib/Hledger/Data/Journal.hs | 2 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 45 +-- .../Hledger/Reports/MultiBalanceReports.hs | 11 +- hledger-lib/Hledger/Reports/PostingsReport.hs | 60 +++- hledger-lib/Hledger/Reports/ReportOptions.hs | 9 +- hledger/Hledger/Cli/Commands/Balance.hs | 22 +- hledger/Hledger/Cli/Commands/Register.hs | 14 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 16 +- hledger/Hledger/Cli/Utils.hs | 36 +-- hledger/hledger_options.m4.md | 19 +- tests/journal/market-prices.test | 280 ++++++++++-------- 11 files changed, 314 insertions(+), 200 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 963b67396..20cf2c992 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1010,7 +1010,7 @@ journalAmounts = getConst . traverseJournalAmounts (Const . (:[])) overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f) --- | Traverses over all ofthe amounts in the journal, in the order +-- | Traverses over all of the amounts in the journal, in the order -- indicated by 'journalAmounts'. traverseJournalAmounts :: Applicative f diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 8b31ec079..9237c4827 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -180,33 +180,38 @@ brNegate (is, tot) = (map brItemNegate is, -tot) -- or a specified date. brValue :: ReportOpts -> Journal -> BalanceReport -> BalanceReport brValue ropts@ReportOpts{..} j (items, total) = - ([ (n, n', i, mixedAmountValue prices d a) | (n,n',i,a) <- items ] - ,mixedAmountValue prices d total + ([ (n, n', i, val a) | (n,n',i,a) <- items ] + ,val total ) where + val amt = + let val' d = mixedAmountValue prices d amt in + case value_at_ of + AtTransaction -> amt -- this case is converted earlier, see Balance.hs + AtPeriod -> + let mperiodorjournallastday = mperiodlastday <|> journalEndDate False j + -- Get the last day of the report period. + -- Will be Nothing if no report period is specified, or also + -- if ReportOpts does not have today_ set, since we need that + -- to get the report period robustly. + mperiodlastday :: Maybe Day = do + t <- today_ + let q = queryFromOpts t ropts + qend <- queryEndDate False q + return $ addDays (-1) qend + d = fromMaybe (error' "brValue: expected a non-empty journal") -- XXX shouldn't happen + mperiodorjournallastday + in val' d + AtNow -> case today_ of + Just d -> val' d + Nothing -> error' "brValue: ReportOpts today_ is unset so could not satisfy --value-at=now" + AtDate d -> val' d + -- prices are in parse order - sort into date then parse order, -- & reversed for quick lookup of the latest price. prices = reverse $ sortOn mpdate $ jmarketprices j - d = case value_at_ of - AtTransaction -> error' "sorry, --value-at=transaction is not yet supported with balance reports" -- XXX - AtPeriod -> fromMaybe (error' "brValue: expected a non-empty journal") mperiodorjournallastday -- XXX shouldn't happen - AtNow -> case today_ of - Just d -> d - Nothing -> error' "brValue: ReportOpts today_ is unset so could not satisfy --value-at=now" - AtDate d -> d - -- Get the last day of the report period. - -- Will be Nothing if no report period is specified, or also - -- if ReportOpts does not have today_ set, since we need that - -- to get the report period robustly. - mperiodlastday :: Maybe Day = do - t <- today_ - let q = queryFromOpts t ropts - qend <- queryEndDate False q - return $ addDays (-1) qend - mperiodorjournallastday = mperiodlastday <|> journalEndDate False j - -- -- | Find the best commodity to convert to when asked to show the -- -- market value of this commodity on the given date. That is, the one -- -- in which it has most recently been market-priced, ie the commodity diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 6d28d5518..288b9057c 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -291,15 +291,18 @@ mbrValue ReportOpts{..} Journal{..} (MultiBalanceReport (spans, rows, (coltotals ,val end rowavgtotal) ) where - ends = map (fromMaybe (error' "mbrValue: expected all report periods to have an end date") . spanEnd) spans -- XXX shouldn't happen + ends = map (addDays (-1) . fromMaybe (error' "mbrValue: expected all report periods to have an end date") . spanEnd) spans -- XXX shouldn't happen end = lastDef (error' "mbrValue: expected at least one report subperiod") ends -- XXX shouldn't happen - val periodend amt = mixedAmountValue prices d amt + val periodend amt = mixedAmountValue prices valuationdate amt where -- prices are in parse order - sort into date then parse order, -- & reversed for quick lookup of the latest price. prices = reverse $ sortOn mpdate jmarketprices - d = case value_at_ of - AtTransaction -> error' "sorry, --value-at=transaction is not yet supported with balance reports" -- XXX + valuationdate = case value_at_ of + AtTransaction -> + error' "sorry, --value-at=transaction with balance reports is not yet supported" + AtPeriod | average_ || row_total_ -> + error' "sorry, --value-at=period with -T or -A in periodic balance reports is not yet supported" AtPeriod -> periodend AtNow -> case today_ of Just d -> d diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index ab8dab9c6..4ef1b2b47 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -90,8 +90,16 @@ postingsReport opts q j = startbal | average_ opts = if historical then precedingavg else 0 | otherwise = if historical then precedingsum else 0 startnum = if historical then length precedingps + 1 else 1 - runningcalc | average_ opts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg) -- running average - | otherwise = \_ bal amt -> bal + amt -- running total + runningcalc = registerRunningCalculationFn opts + +-- | Based on the given report options, return a function that does the appropriate +-- running calculation for the register report, ie a running average or running total. +-- This function will take the item number, previous average/total, and new posting amount, +-- and return the new average/total. +registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) +registerRunningCalculationFn ropts + | average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg) + | otherwise = \_ bal amt -> bal + amt totallabel = "Total" @@ -240,23 +248,45 @@ negatePostingAmount p = p { pamount = negate $ pamount p } -- or the posting dates if journal is empty - shouldn't happen), -- or today's date (gives an error if today_ is not set in ReportOpts), -- or a specified date. +-- +-- Special case: when --value-at=transaction is combined with a report interval, +-- assume amounts were converted to value earlier and do nothing here. +-- prValue :: ReportOpts -> Journal -> PostingsReport -> PostingsReport prValue ropts@ReportOpts{..} j@Journal{..} (totallabel, items) = (totallabel, items') where - items' = [ (md, md2, desc, p{pamount=val $ pamount p}, val tot) - | (md, md2, desc, p, tot) <- items - , let val = mixedAmountValue prices (valuationdate $ postingDate p) + -- convert postings amounts to value + items' = [ (md, md2, desc, p', t') | (md, md2, desc, p, t) <- items + , let pdate = postingDate p + , let pamt' = val pdate (pamount p) + , let p' = p{pamount = pamt'} + , let t' = val pdate t -- In some cases, revaluing the totals/averages is fine. + -- With --value-at=t, we revalue postings early instead. + -- XXX --value=at=m -M is still a problem ] - valuationdate pdate = - case value_at_ of - AtTransaction | interval_ /= NoInterval -> error' "sorry, --value-at=transaction is not yet supported with periodic register reports" -- XXX - AtPeriod | interval_ /= NoInterval -> error' "sorry, --value-at=transaction is not yet supported with periodic register reports" -- XXX - AtTransaction -> pdate - AtPeriod -> fromMaybe pdate mperiodorjournallastday - AtNow -> case today_ of - Just d -> d - Nothing -> error' "prValue: ReportOpts today_ is unset so could not satisfy --value-at=now" - AtDate d -> d + + val pdate amt = + let val' d = mixedAmountValue prices d amt in + case (value_at_, interval_) of + (AtTransaction, _) -> amt -- in this case we revalued postings early (Register.hs) + (AtPeriod, NoInterval) -> val' $ fromMaybe pdate mperiodorjournallastday + (AtPeriod, _) -> + error' "sorry, --value-at=period with periodic register reports is not yet supported" + -- XXX need to calculate total from period-valued postings + -- -- Get the last day of this subperiod. We can't always get it from the report item + -- -- (only the first items in each period have the period start/end dates). + -- -- The following kludge seems to work.. XXX + -- let subperiodlastday = + -- addDays (-1) $ + -- fromMaybe (error' "prValue: expected a date here") $ -- should not happen + -- spanEnd $ + -- headDef (error' "prValue: expected at least one span here") $ -- should not happen, splitting a well-formed span + -- splitSpan i (DateSpan (Just pdate) Nothing) + -- in val' subperiodlastday + (AtNow, _) -> case today_ of + Just d -> val' d + Nothing -> error' "prValue: ReportOpts today_ is unset so could not satisfy --value-at=now" + (AtDate d, _) -> val' d where mperiodorjournallastday = mperiodlastday <|> journalEndDate False j -- Get the last day of the report period. diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index e482f5ce3..8ce16f153 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -82,7 +82,7 @@ data ValueDate = | AtPeriod -- ^ Calculate values as of each report period's last day | AtNow -- ^ Calculate values as of today (report generation date) | AtDate Day -- ^ Calculate values as of some other date - deriving (Show,Data) -- Eq,Typeable + deriving (Show,Data,Eq) -- Typeable instance Default ValueDate where def = AtNow @@ -99,8 +99,8 @@ data ReportOpts = ReportOpts { ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,cost_ :: Bool - ,value_ :: Bool - ,value_at_ :: ValueDate + ,value_ :: Bool -- ^ Should amounts be converted to market value + ,value_at_ :: ValueDate -- ^ Which valuation date should be used for market value ,depth_ :: Maybe Int ,display_ :: Maybe DisplayExp -- XXX unused ? ,date2_ :: Bool @@ -109,8 +109,9 @@ data ReportOpts = ReportOpts { ,real_ :: Bool ,format_ :: Maybe FormatStr ,query_ :: String -- all arguments, as a string - -- register command only + -- ,average_ :: Bool + -- register command only ,related_ :: Bool -- balance-type commands only ,balancetype_ :: BalanceType diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index b4c41331c..57c5f5c79 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -234,6 +234,7 @@ Currently, empty cells show 0. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NamedFieldPuns #-} @@ -300,14 +301,14 @@ balancemode = hledgerCommandMode -- | The balance command, prints a balance report. balance :: CliOpts -> Journal -> IO () -balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do +balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do d <- getCurrentDay case lineFormatFromOpts ropts of Left err -> error' $ unlines [err] Right _ -> do let format = outputFormatFromOpts opts budget = boolopt "budget" rawopts - interval = interval_ ropts + interval = interval_ case (budget, interval) of (True, _) -> do @@ -324,13 +325,16 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do (False, NoInterval) -> do -- single column balance report + -- With --value-at=transaction, convert all amounts to value before summing them. + let j' | value_at_ == AtTransaction = journalValueAtTransactionDate ropts j + | otherwise = j let report - | balancetype_ ropts `elem` [HistoricalBalance, CumulativeChange] + | balancetype_ `elem` [HistoricalBalance, CumulativeChange] = let ropts' | flat_ ropts = ropts | otherwise = ropts{accountlistmode_=ALTree} - in balanceReportFromMultiBalanceReport ropts' (queryFromOpts d ropts) j + in balanceReportFromMultiBalanceReport ropts' (queryFromOpts d ropts) j' -- for historical balances we must use balanceReportFromMultiBalanceReport (also forces --no-elide) - | otherwise = balanceReport ropts (queryFromOpts d ropts) j -- simple Ledger-style balance report + | otherwise = balanceReport ropts (queryFromOpts d ropts) j' -- simple Ledger-style balance report render = case format of "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO @@ -339,7 +343,13 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do _ -> do -- multi column balance report - let report = multiBalanceReport ropts (queryFromOpts d ropts) j + + -- With --value-at=transaction, convert all amounts to value before summing them. + let j' | value_at_ == AtTransaction = + error' "sorry, --value-at=transaction with balance reports is not yet supported" -- journalValueAtTransactionDate ropts j + | otherwise = j + + let report = multiBalanceReport ropts (queryFromOpts d ropts) j' render = case format of "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts "html" -> (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 8d2493a84..eab4539fe 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -4,7 +4,9 @@ A ledger-compatible @register@ command. -} -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Hledger.Cli.Commands.Register ( @@ -53,13 +55,19 @@ registermode = hledgerCommandMode -- | Print a (posting) register report. register :: CliOpts -> Journal -> IO () -register opts@CliOpts{reportopts_=ropts} j = do +register opts@CliOpts{reportopts_=ropts@ReportOpts{..}} j = do d <- getCurrentDay let fmt = outputFormatFromOpts opts render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv) | fmt=="html" = const $ error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO | otherwise = postingsReportAsText - writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j + + -- For register reports with --value-at=transaction, + -- convert all amounts to value before summing them. + j' | value_at_ == AtTransaction = journalValueAtTransactionDate ropts j + | otherwise = j + + writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j' postingsReportAsCsv :: PostingsReport -> CSV postingsReportAsCsv (_,is) = diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 34e0dff83..9e8f26cc4 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -25,7 +25,7 @@ import Text.Tabular as T import Hledger import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions -import Hledger.Cli.Utils (writeOutput) +import Hledger.Cli.Utils (journalValueAtTransactionDate, writeOutput) -- | Description of a compound balance report command, -- from which we generate the command's cmdargs mode and IO action. @@ -207,17 +207,21 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r -- | Run one subreport for a compound balance command in multi-column mode. -- This returns a MultiBalanceReport. compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport -compoundBalanceSubreport ropts userq j subreportqfn subreportnormalsign = r' +compoundBalanceSubreport ropts@ReportOpts{..} userq j subreportqfn subreportnormalsign = r' where + -- With --value-at=transaction and a periodic report, convert all amounts to value before summing them. + j' | value_at_ == AtTransaction && interval_ /= NoInterval = journalValueAtTransactionDate ropts j + | otherwise = j + -- force --empty to ensure same columns in all sections ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign } -- run the report - q = And [subreportqfn j, userq] - r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j + q = And [subreportqfn j', userq] + r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j' -- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts -- in this report - r' | empty_ ropts = r - | otherwise = MultiBalanceReport (dates, rows', totals) + r' | empty_ = r + | otherwise = MultiBalanceReport (dates, rows', totals) where nonzeroaccounts = dbg1 "nonzeroaccounts" $ diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index a4a020990..08f6aba22 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-| @@ -12,8 +13,8 @@ module Hledger.Cli.Utils withJournalDo, writeOutput, journalTransform, - -- journalApplyValue, journalAddForecast, + journalValueAtTransactionDate, journalReload, journalReloadIfChanged, journalFileIsNewer, @@ -120,24 +121,23 @@ anonymise j where anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash --- TODO move journalApplyValue and friends to Hledger.Data.Journal ? --- They are here because they use ReportOpts +-- journalApplyValue and friends are here not in Hledger.Data.Journal +-- because they use ReportOpts. --- XXX we might still use this for --value-date=transaction --- -- | Convert all the journal's posting amounts to their market value as of --- -- each posting's date. --- -- Cf http://hledger.org/manual.html#market-value --- journalApplyValue :: ReportOpts -> Journal -> IO Journal --- journalApplyValue ropts j = do --- today <- getCurrentDay --- mspecifiedenddate <- specifiedEndDate ropts --- let d = fromMaybe today mspecifiedenddate --- -- prices are in parse order - sort into date then parse order, --- -- reversed for quick lookup of the latest price. --- ps = reverse $ sortOn mpdate $ jmarketprices j --- convert | value_ ropts = overJournalAmounts (amountValue ps d) --- | otherwise = id --- return $ convert j +-- | Convert all the journal's posting amounts to their market value +-- as of each posting's date. Needed when converting some periodic +-- reports to value, when --value-at=transaction (only). +-- See eg Register.hs. +journalValueAtTransactionDate :: ReportOpts -> Journal -> Journal +journalValueAtTransactionDate ReportOpts{..} j@Journal{..} + | value_at_ /= AtTransaction = j + | otherwise = j{jtxns = map txnvalue jtxns} + where + txnvalue t@Transaction{..} = t{tpostings=map postingvalue tpostings} + postingvalue p@Posting{..} = p{pamount=mixedAmountValue prices (postingDate p) pamount} + -- prices are in parse order - sort into date then parse order, + -- reversed for quick lookup of the latest price. + prices = reverse $ sortOn mpdate jmarketprices -- | Generate periodic transactions from all periodic transaction rules in the journal. -- These transactions are added to the in-memory Journal (but not the on-disk file). diff --git a/hledger/hledger_options.m4.md b/hledger/hledger_options.m4.md index 374776681..b0eea3b03 100644 --- a/hledger/hledger_options.m4.md +++ b/hledger/hledger_options.m4.md @@ -501,12 +501,10 @@ The precise effect of the keywords is command-specific, but here is their genera - `--value-at=transaction` (or `t`) : Use the prices as of each transaction date (more precisely, each [posting date](/journal.html#posting-dates)). -: (Currently not supported with: balance commands, periodic register reports.) - `--value-at=period` (or `p`) : Use the prices as of the last day of the report period (or each subperiod). : When no report period is specified, this will be the journal's last transaction date. -: (Currently not supported with: periodic register reports.) - `--value-at=now` (or `n`) : Use the prices as of today's date when the report is generated. This is the default. @@ -600,6 +598,23 @@ $ hledger -f- print --value-at=2000-01-15 ``` +### Reports supporting --value-at + +Not all combinations of valuation date and hledger report modes are +supported or well understood at present +([#329](https://github.com/simonmichael/hledger/issues/329)). +Here are the ones currently supported +("print", "register", and "balance" here mean all commands of that general type): + +| Report type | `--value-at=` `transaction`  | `--value-at=` `period`  | `--value-at=` `DATE`/`now`  | +|---------------------------------------------------------|:---------------------------------:|:----------------------------:|:--------------------------------:| +| print | Y | Y | Y | +| register | Y | Y | Y | +| register, multiperiod | Y | - | Y | +| balance | Y | Y | Y | +| balance, multiperiod | - | Y | Y | +| balance, multiperiod, -T/-A | - | - | Y | +| register/balance, multiperiod, -T/-A, -H | ? | ? | ? | ## Combining -B and -V diff --git a/tests/journal/market-prices.test b/tests/journal/market-prices.test index 2627f1511..23de0468c 100644 --- a/tests/journal/market-prices.test +++ b/tests/journal/market-prices.test @@ -113,9 +113,11 @@ $ hledger -f- print -V >=0 -# print --value-at +# --value-at tests + < 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 @@ -129,7 +131,9 @@ P 2000/04/01 A 4 B 2000/03/01 (a) 1 A -# 9. value with prices on transaction (posting) dates +# print + +# 9. print value using prices on transaction (posting) dates $ hledger -f- print --value-at=transaction 2000/01/01 (a) 1 B @@ -142,7 +146,7 @@ $ hledger -f- print --value-at=transaction >=0 -# 10. value with prices on last day of report period (2000-02-29) +# 10. print value using prices on last day of report period (2000-02-29) $ hledger -f- print --value-at=period date:2000/01-2000/03 2000/01/01 (a) 2 B @@ -152,7 +156,7 @@ $ hledger -f- print --value-at=period date:2000/01-2000/03 >=0 -# 11. value with prices on last day of report period with no period +# 11. print value using prices on last day of report period (no period specified) # specified - uses last day of journal (2000-03-01) $ hledger -f- print --value-at=period 2000/01/01 @@ -166,8 +170,21 @@ $ hledger -f- print --value-at=period >=0 -# 12. value with prices on current date -# (this test assumes today's date is >= 2000-04-01) +# 12. print value using prices on a specified date +$ hledger -f- print --value-at=2000-01-15 +2000/01/01 + (a) 5 B + +2000/02/01 + (a) 5 B + +2000/03/01 + (a) 5 B + +>=0 + +# 13. print value using prices today +# (assuming today's date is >= 2000-04-01) $ hledger -f- print --value-at=now 2000/01/01 (a) 4 B @@ -180,45 +197,147 @@ $ hledger -f- print --value-at=now >=0 -# 13. value with prices on a custom date -$ hledger -f- print --value-at=2000-01-15 -2000/01/01 - (a) 1 B +# register -2000/02/01 - (a) 1 B - -2000/03/01 - (a) 1 B - ->=0 - -# 14. multicolumn balance report with default value -$ hledger -f- bal -M -V -Balance changes in 2000q1: - - || Jan Feb Mar -===++=============== - a || 4 B 4 B 4 B ----++--------------- - || 4 B 4 B 4 B - -# 15. multicolumn balance report valued at transaction is not supported -$ hledger -f- bal -M --value-at=transaction ->2 /not yet supported with balance reports/ ->=1 +# 14. register report valued at transaction. +# Shows the running total of the posting amount values (not the values +# of the running total). +$ hledger -f- reg --value-at=transaction +2000/01/01 (a) 1 B 1 B +2000/02/01 (a) 2 B 3 B +2000/03/01 (a) 3 B 6 B -# 16. multicolumn balance report valued at period end +# 15. register report valued at period end +$ hledger -f- reg --value-at=period +2000/01/01 (a) 3 B 3 B +2000/02/01 (a) 3 B 6 B +2000/03/01 (a) 3 B 9 B + +# 16. register report valued at specified date +$ hledger -f- reg --value-at=2000-01-15 +2000/01/01 (a) 5 B 5 B +2000/02/01 (a) 5 B 10 B +2000/03/01 (a) 5 B 15 B + +# 17. register report valued today +$ hledger -f- reg --value-at=now +2000/01/01 (a) 4 B 4 B +2000/02/01 (a) 4 B 8 B +2000/03/01 (a) 4 B 12 B + +# 18. register report valued at default date (same as above) +$ hledger -f- reg -V +2000/01/01 (a) 4 B 4 B +2000/02/01 (a) 4 B 8 B +2000/03/01 (a) 4 B 12 B + +# register, periodic + +# 19. periodic register report valued at transaction +$ hledger -f- reg --value-at=transaction -M +2000/01 a 1 B 1 B +2000/02 a 2 B 3 B +2000/03 a 3 B 6 B + +# 20. periodic register report valued at period end +$ hledger -f- reg --value-at=period -M +>2 /not yet supported/ +>=1 +# XXX +# 2000/01 a 5 B 5 B +# 2000/02 a 2 B 7 B +# 2000/03 a 3 B 10 B + +# 21. periodic register report valued at specified date +$ hledger -f- reg --value-at=2000-01-15 -M +2000/01 a 5 B 5 B +2000/02 a 5 B 10 B +2000/03 a 5 B 15 B + +# 22. periodic register report valued today +$ hledger -f- reg --value-at=now -M +2000/01 a 4 B 4 B +2000/02 a 4 B 8 B +2000/03 a 4 B 12 B + +# 23. periodic register report valued at default date (same as above) +$ hledger -f- reg -V -M +2000/01 a 4 B 4 B +2000/02 a 4 B 8 B +2000/03 a 4 B 12 B + +# balance + +# 24. single column balance report valued at transaction +$ hledger -f- bal --value-at=transaction + 6 B a +-------------------- + 6 B + +# 25. single column balance report valued at period end +$ hledger -f- bal --value-at=period + 9 B a +-------------------- + 9 B + +# 26. single column balance report valued at specified date +$ hledger -f- bal --value-at=2000-01-15 + 15 B a +-------------------- + 15 B + +# 27. single column balance report valued today +$ hledger -f- bal --value-at=now + 12 B a +-------------------- + 12 B + +# 28. single column balance report valued at default date (same as above) +$ hledger -f- bal -V + 12 B a +-------------------- + 12 B + +# balance, periodic + +# 29. multicolumn balance report valued at transaction +$ hledger -f- bal -MTA --value-at=transaction +>2 /not yet supported/ +>=1 +# Balance changes in 2000q1: +# +# || Jan Feb Mar Total Average +# ===++================================= +# a || 1 B 2 B 3 B 6 B 2 B +# ---++--------------------------------- +# || 1 B 2 B 3 B 6 B 2 B + +# 30. multicolumn balance report valued at period end $ hledger -f- bal -M --value-at=period Balance changes in 2000q1: || Jan Feb Mar ===++=============== - a || 2 B 3 B 4 B + a || 5 B 2 B 3 B ---++--------------- - || 2 B 3 B 4 B + || 5 B 2 B 3 B -# 17. multicolumn balance report valued at today +# 31. multicolumn balance report valued at period end with -T or -A +$ hledger -f- bal -M --value-at=period -TA +>2 /not yet supported/ +>=1 + +# 32. multicolumn balance report valued at other date +$ hledger -f- bal -M --value-at=2000-01-15 +Balance changes in 2000q1: + + || Jan Feb Mar +===++=============== + a || 5 B 5 B 5 B +---++--------------- + || 5 B 5 B 5 B + +# 33. multicolumn balance report valued today (with today >= 2000-04-01) $ hledger -f- bal -M --value-at=now Balance changes in 2000q1: @@ -228,94 +347,13 @@ Balance changes in 2000q1: ---++--------------- || 4 B 4 B 4 B -# 18. multicolumn balance report valued at other date -$ hledger -f- bal -M --value-at=2000-01-15 +# 34. multicolumn balance report valued at default date (same as above) +$ hledger -f- bal -M -V Balance changes in 2000q1: || Jan Feb Mar ===++=============== - a || 1 B 1 B 1 B + a || 4 B 4 B 4 B ---++--------------- - || 1 B 1 B 1 B - -# 19. single column balance report with default value -$ hledger -f- bal -V - 12 B a --------------------- - 12 B - -# 20. single column balance report valued at transaction is not supported -$ hledger -f- bal --value-at=transaction ->2 /not yet supported with balance reports/ ->=1 - -# 21. single column balance report valued at period end -$ hledger -f- bal --value-at=period - 9 B a --------------------- - 9 B - -# 22. single column balance report valued at today -$ hledger -f- bal --value-at=now - 12 B a --------------------- - 12 B - -# 23. single column balance report valued at other date -$ hledger -f- bal --value-at=2000-01-15 - 3 B a --------------------- - 3 B - -# 24. register report with default value -$ hledger -f- reg -V -2000/01/01 (a) 4 B 4 B -2000/02/01 (a) 4 B 8 B -2000/03/01 (a) 4 B 12 B - -# 25. register report valued at transaction -$ hledger -f- reg --value-at=transaction -2000/01/01 (a) 1 B 1 B -2000/02/01 (a) 2 B 4 B -2000/03/01 (a) 3 B 9 B - -# 26. register report valued at period end -$ hledger -f- reg --value-at=period -2000/01/01 (a) 3 B 3 B -2000/02/01 (a) 3 B 6 B -2000/03/01 (a) 3 B 9 B - -# 27. register report valued at today -$ hledger -f- reg --value-at=now -2000/01/01 (a) 4 B 4 B -2000/02/01 (a) 4 B 8 B -2000/03/01 (a) 4 B 12 B - -# 28. register report valued at other date -$ hledger -f- reg --value-at=2000-01-15 -2000/01/01 (a) 1 B 1 B -2000/02/01 (a) 1 B 2 B -2000/03/01 (a) 1 B 3 B - -# 29. periodic register report with default value -$ hledger -f- reg -V -Q -2000q1 a 12 B 12 B - -# 30. periodic register report valued at transaction -$ hledger -f- reg --value-at=transaction -Q ->2 /not yet supported with periodic register reports/ ->=1 - -# 31. periodic register report valued at period end -$ hledger -f- reg --value-at=period -Q ->2 /not yet supported with periodic register reports/ ->=1 - -# 32. periodic register report valued at today -$ hledger -f- reg --value-at=now -Q -2000q1 a 12 B 12 B - -# 33. periodic register report valued at other date -$ hledger -f- reg --value-at=2000-01-15 -Q -2000q1 a 3 B 3 B + || 4 B 4 B 4 B