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