diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index e423561e3..359ed1dec 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-} {-| Journal entries report, used by the print command. @@ -16,7 +16,9 @@ where import Control.Applicative ((<|>)) import Data.List +import Data.Maybe import Data.Ord +import Data.Time.Calendar (Day, addDays) import Hledger.Data import Hledger.Query @@ -42,22 +44,42 @@ entriesReport opts q j = -- | Convert all the posting amounts in an EntriesReport to their -- default valuation commodities. This means using the Journal's most -- recent applicable market prices before the valuation date. --- The valuation date is the specified report end date if any, --- otherwise the current date, otherwise the journal's end date. +-- The valuation date is set with --value-date and can be: +-- a custom date; +-- the posting date; +-- the last day in the report period, or in the journal if no period +-- (or the posting date, if journal is empty - shouldn't happen); +-- or today's date (gives an error if today_ is not set in ReportOpts). erValue :: ReportOpts -> Journal -> EntriesReport -> EntriesReport -erValue ropts j ts = - let mvaluationdate = periodEnd (period_ ropts) <|> today_ ropts <|> journalEndDate False j - in case mvaluationdate of - Nothing -> ts - Just d -> map valuetxn ts +erValue ropts@ReportOpts{..} j ts = + map txnvalue ts + where + txnvalue t@Transaction{..} = t{tpostings=map postingvalue tpostings} + postingvalue p@Posting{..} = p{pamount=mixedAmountValue prices d pamount} 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 j - valuetxn t@Transaction{..} = t{tpostings=map valueposting tpostings} - valueposting p@Posting{..} = p{pamount=mixedAmountValue prices d pamount} + -- 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 + + d = case value_date_ of + ValueOn d -> d + TransactionValue -> postingDate p + PeriodEndValue -> fromMaybe (postingDate p) mperiodorjournallastday + CurrentValue -> case today_ of + Just d -> d + Nothing -> error' "ReportOpts today_ is unset so could not satisfy --value-date=current" tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index ad151ad49..68647b14d 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -10,6 +10,7 @@ module Hledger.Reports.ReportOptions ( ReportOpts(..), BalanceType(..), AccountListMode(..), + ValueDate(..), FormatStr, defreportopts, rawOptsToReportOpts, @@ -72,6 +73,17 @@ data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typ instance Default AccountListMode where def = ALDefault +-- | On which date(s) should amount values be calculated ? +-- UI: --value-date=transaction|period|current|DATE +data ValueDate = + TransactionValue -- ^ Calculate values as of each transaction's (actually, each posting's) date + | PeriodEndValue -- ^ Calculate values as of each report period's end + | CurrentValue -- ^ Calculate values as of today + | ValueOn Day -- ^ Calculate values as of a specified date + deriving (Show,Data) -- Eq,Typeable + +instance Default ValueDate where def = CurrentValue + -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options -- or query arguments, but not all. Some are used only by certain @@ -84,6 +96,8 @@ data ReportOpts = ReportOpts { ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,cost_ :: Bool + ,value_ :: Bool + ,value_date_ :: ValueDate ,depth_ :: Maybe Int ,display_ :: Maybe DisplayExp -- XXX unused ? ,date2_ :: Bool @@ -101,7 +115,6 @@ data ReportOpts = ReportOpts { ,drop_ :: Int ,row_total_ :: Bool ,no_total_ :: Bool - ,value_ :: Bool ,pretty_tables_ :: Bool ,sort_amount_ :: Bool ,invert_ :: Bool -- ^ if true, flip all amount signs in reports @@ -150,6 +163,7 @@ defreportopts = ReportOpts def def def + def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do @@ -162,6 +176,8 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,interval_ = intervalFromRawOpts rawopts' ,statuses_ = statusesFromRawOpts rawopts' ,cost_ = boolopt "cost" rawopts' + ,value_ = boolopt "value" rawopts' + ,value_date_ = valueDateFromRawOpts rawopts' ,depth_ = maybeintopt "depth" rawopts' ,display_ = maybedisplayopt d rawopts' ,date2_ = boolopt "date2" rawopts' @@ -177,7 +193,6 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,drop_ = intopt "drop" rawopts' ,row_total_ = boolopt "row-total" rawopts' ,no_total_ = boolopt "no-total" rawopts' - ,value_ = boolopt "value" rawopts' ,sort_amount_ = boolopt "sort-amount" rawopts' ,invert_ = boolopt "invert" rawopts' ,pretty_tables_ = boolopt "pretty-tables" rawopts' @@ -328,6 +343,20 @@ reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss} | s `elem` ss = ropts{statuses_=filter (/= s) ss} | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} +valueDateFromRawOpts :: RawOpts -> ValueDate +valueDateFromRawOpts = lastDef CurrentValue . catMaybes . map valuedatefromrawopt + where + valuedatefromrawopt (n,v) + | n == "value-date" = valuedatevalue v + | otherwise = Nothing + valuedatevalue v + | v `elem` ["transaction","t"] = Just TransactionValue + | v `elem` ["period","p"] = Just PeriodEndValue + | v `elem` ["current","c"] = Just CurrentValue + | otherwise = flip maybe (Just . ValueOn) + (usageError $ "could not parse \""++v++"\" as value date, should be: transaction|period|current|t|p|c|YYYY-MM-DD") + (parsedateM v) + type DisplayExp = String maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 2b89e0b47..5ff2c4bcc 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -148,7 +148,8 @@ reportflags = [ ,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "NUM" "(or -NUM): hide accounts/postings deeper than this" ,flagNone ["empty","E"] (setboolopt "empty") "show items with zero amount, normally hidden (and vice-versa in hledger-ui/hledger-web)" ,flagNone ["cost","B"] (setboolopt "cost") "convert amounts to their cost at transaction time (using the transaction price, if any)" - ,flagNone ["value","V"] (setboolopt "value") "convert amounts to their market value on the report end date (using the most recent applicable market price, if any)" + ,flagNone ["value","V"] (setboolopt "value") "convert amounts to their market value" + ,flagReq ["value-date"] (\s opts -> Right $ setopt "value-date" s opts) "VALUEDATE" "as of which date(s) should market values be calculated ? transaction|period|current|YYYY-MM-DD (default: current)" ,flagNone ["auto"] (setboolopt "auto") "apply automated posting rules to modify transactions" ,flagNone ["forecast"] (setboolopt "forecast") "apply periodic transaction rules to generate future transactions, to 6 months from now or report end date" ] diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 465f725ae..a4a020990 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -12,6 +12,7 @@ module Hledger.Cli.Utils withJournalDo, writeOutput, journalTransform, + -- journalApplyValue, journalAddForecast, journalReload, journalReloadIfChanged, @@ -72,14 +73,18 @@ withJournalDo opts cmd = do >>= either error' cmd -- | Apply some extra post-parse transformations to the journal, if --- specified by options. These include: +-- specified by options. These happen after journal validation, but +-- before report calculation. They include: -- -- - adding forecast transactions (--forecast) -- - pivoting account names (--pivot) -- - anonymising (--anonymise). +-- journalTransform :: CliOpts -> Journal -> IO Journal journalTransform opts@CliOpts{reportopts_=_ropts} = journalAddForecast opts +-- - converting amounts to market value (--value) + -- >=> journalApplyValue ropts >=> return . pivotByOpts opts >=> return . anonymiseByOpts opts @@ -115,6 +120,25 @@ 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 + +-- 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 + -- | 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 c05142951..c120c0c77 100644 --- a/hledger/hledger_options.m4.md +++ b/hledger/hledger_options.m4.md @@ -450,16 +450,9 @@ if they have a [transaction price](/journal.html#transaction-prices) specified. ## Market value -The `-V/--value` flag converts reported amounts to their current market value. -Specifically, when there is a -[market price](journal.html#market-prices) (P directive) for the -amount's commodity, dated on or before today's date (or the -[report end date](#report-start-end-date) if specified), the amount -will be converted to the price's commodity. - -When there are multiple applicable P directives, -V chooses the most -recent one, or in case of equal dates, the last-parsed one. - +The `-V/--value` flag converts reported amounts to their market value in some other commodity. +It uses the latest [market price](journal.html#market-prices) (declared with a P directive) +dated on or before the valuation date. The default valuation date is today. For example: ```journal @@ -490,13 +483,127 @@ $ hledger -f t.j bal -N euros -V $103.00 assets:euros ``` -Currently, hledger's -V only uses market prices recorded with P directives, -not [transaction prices](journal.html#transaction-prices) (unlike Ledger). +A note for Ledger users: Ledger's -V also infers market prices from journal entries, +but we don't do that. hledger's -V uses only market prices declared explicitly, with P directives. +(Mnemonic: -B/--cost uses transaction prices, -V/--value uses market prices.) + +### Value date + +*(experimental, added 201904)* + +You can select other valuation dates with the `--value-date` option: + + --value-date=VALUEDATE as of which date(s) should market values be + calculated ? transaction|period|current|YYYY-MM-DD + (default: current) + +The argument must be one of those keywords, or their first letter, or a custom date. +The precise effect of the keywords is command-specific, but here is their general meaning: + +- `--value-date=transaction` (or `t`) +: Use the prices as of each transaction date (more precisely, each [posting date](/journal.html#posting-dates)). + +- `--value-date=period` (or `p`) +: Use the prices as of the last day of the report period (or each subperiod). +: Or if the report period is unspecified, as of the journal's last transaction date. + +- `--value-date=current` (or `c`) +: Use the prices as of today's date (when the report is generated). This is the default. + +- `--value-date=YYYY-MM-DD` +: Use the prices as of the given date (must be 8 digits with `-` or `/` or `.` separators). +: Eg `--value-date=2019-04-25`. + +Currently `--value-date` affects only the [print](/hledger.html#print) command. +Here are some examples to show its effect: + +```journal +P 2000-01-01 A 1 B +P 2000-02-01 A 2 B +P 2000-03-01 A 3 B +P 2000-04-01 A 4 B + +2000-01-01 + (a) 1 A + +2000-02-01 + (a) 1 A + +2000-03-01 + (a) 1 A +``` + +Show the value as of each transaction (posting) date: +```shell +$ hledger -f- print -V --value-date=transaction +2000/01/01 + (a) 1 B + +2000/02/01 + (a) 2 B + +2000/03/01 + (a) 3 B + +``` + +Show the value as of the last day of the report period (2000-02-29): +```shell +$ hledger -f- print -V --value-date=period date:2000/01-2000/03 +2000-01-01 + (a) 2 B + +2000-02-01 + (a) 2 B + +``` + +Or with no report period specified, show the value as of the last day of the journal (2000-03-01): +```shell +$ hledger -f- print -V --value-date=period +2000/01/01 + (a) 3 B + +2000/02/01 + (a) 3 B + +2000/03/01 + (a) 3 B + +``` + +Show the current value (the last declared price is still in effect today): +```shell +$ hledger -f- print -V --value-date=current +2000-01-01 + (a) 4 B + +2000-02-01 + (a) 4 B + +2000-03-01 + (a) 4 B + +``` + +Show the value on 2000/01/15: +```shell +$ hledger -f- print -V --value-date=2000-01-15 +2000/01/01 + (a) 1 B + +2000/02/01 + (a) 1 B + +2000/03/01 + (a) 1 B + +``` + + + + -Currently, -V has a limitation in -[multicolumn balance reports](#multicolumn-balance-reports): -it uses the market prices on the report end date for all columns. -(Instead of the prices on each column's end date.) ## Combining -B and -V diff --git a/tests/journal/market-prices.test b/tests/journal/market-prices.test index 415889279..5fefc7999 100644 --- a/tests/journal/market-prices.test +++ b/tests/journal/market-prices.test @@ -96,7 +96,7 @@ $ hledger -f- balance -V 0.48 H -# 7. register: -V affects posting amounts and total. +# 7. register -V affects posting amounts and total. < P 2000/1/1 $ €1.20 2000/1/1 @@ -106,7 +106,7 @@ $ hledger -f- reg -V 2000/01/01 (a) €120.00 €120.00 -# 8. print: -V affects posting amounts but not balance assertions. +# 8. print -V affects posting amounts but not balance assertions. < P 2000/1/1 $ €1.20 2000/1/1 @@ -117,3 +117,84 @@ $ hledger -f- print -V (a) €120.00 = $100 >=0 + +# print -V --value-date +< +P 2000/01/01 A 1 B +P 2000/02/01 A 2 B +P 2000/03/01 A 3 B +P 2000/04/01 A 4 B + +2000/01/01 + (a) 1 A + +2000/02/01 + (a) 1 A + +2000/03/01 + (a) 1 A + +# 9. value with prices on transaction (posting) dates +$ hledger -f- print -V --value-date=transaction +2000/01/01 + (a) 1 B + +2000/02/01 + (a) 2 B + +2000/03/01 + (a) 3 B + +>=0 + +# 10. value with prices on last day of report period (2000-02-29) +$ hledger -f- print -V --value-date=period date:2000/01-2000/03 +2000/01/01 + (a) 2 B + +2000/02/01 + (a) 2 B + +>=0 + +# 11. value with prices on last day of report period with no period +# specified - uses last day of journal (2000-03-01) +$ hledger -f- print -V --value-date=period +2000/01/01 + (a) 3 B + +2000/02/01 + (a) 3 B + +2000/03/01 + (a) 3 B + +>=0 + +# 12. value with prices on current date +# (this test assumes today's date is >= 2000-04-01) +$ hledger -f- print -V --value-date=current +2000/01/01 + (a) 4 B + +2000/02/01 + (a) 4 B + +2000/03/01 + (a) 4 B + +>=0 + +# 13. value with prices on a custom date +$ hledger -f- print -V --value-date=2000-01-15 +2000/01/01 + (a) 1 B + +2000/02/01 + (a) 1 B + +2000/03/01 + (a) 1 B + +>=0 +