From f999bf78e676e17956d83a43ff7fb347f3e982df Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 23 May 2019 00:36:16 -0700 Subject: [PATCH] opts: new -B/--cost, -V/--market, --value flags (#329) --- hledger-lib/Hledger/Data/Journal.hs | 3 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 14 ++- hledger-lib/Hledger/Reports/BudgetReport.hs | 12 +-- hledger-lib/Hledger/Reports/EntriesReport.hs | 19 ++-- .../Hledger/Reports/MultiBalanceReports.hs | 78 ++++++++--------- hledger-lib/Hledger/Reports/PostingsReport.hs | 33 ++++--- hledger-lib/Hledger/Reports/ReportOptions.hs | 87 +++++++++---------- hledger/Hledger/Cli/CliOptions.hs | 36 +++++++- hledger/Hledger/Cli/Commands/Balance.hs | 12 +-- hledger/Hledger/Cli/Commands/Print.hs | 2 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 20 ++--- tests/budget/budget.test | 2 +- 12 files changed, 169 insertions(+), 149 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index a8c81da45..43f608314 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -978,7 +978,8 @@ canonicalStyleFrom ss@(first:_) = first {asprecision = prec, asdecimalpoint = md -- case ps of (MarketPrice{mpamount=a}:_) -> Just a -- _ -> Nothing --- | Convert all this journal's amounts to cost by applying their prices, if any. +-- | Convert all this journal's amounts to cost using the transaction prices, if any. +-- The journal's commodity styles are applied to the resulting amounts. journalConvertAmountsToCost :: Journal -> Journal journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} where diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index f932d7a88..055cd9901 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -75,13 +75,11 @@ balanceReport ropts@ReportOpts{..} q j = -- transaction: value each posting at posting date before summing -- period: value totals at period end -- date: value totals at date - mvalueat = valueTypeFromOpts ropts today = fromMaybe (error' "balanceReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_ -- For --value-at=transaction, convert all postings to value before summing them. -- The report might not use them all but laziness probably helps here. - j' | mvalueat==Just AtTransaction = - mapJournalPostings (\p -> postingValueAtDate j (postingDate p) p) j + j' -- | mvalueat==Just AtTransaction = mapJournalPostings (\p -> postingValueAtDate j (postingDate p) p) j | otherwise = j -- Get all the summed accounts & balances, according to the query, as an account tree. @@ -92,11 +90,11 @@ balanceReport ropts@ReportOpts{..} q j = where valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance} where - val = case mvalueat of - Just AtPeriod -> mixedAmountValue prices periodlastday - Just AtNow -> mixedAmountValue prices today - Just (AtDate d) -> mixedAmountValue prices d - _ -> id + val = case value_ of + Just (AtEnd _mc) -> mixedAmountValue prices periodlastday + Just (AtNow _mc) -> mixedAmountValue prices today + Just (AtDate d _mc) -> mixedAmountValue prices d + _ -> id where -- prices are in parse order - sort into date then parse order, -- & reversed for quick lookup of the latest price. diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index e6afb6be0..f764a743d 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -275,12 +275,12 @@ budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) = where title = printf "Budget performance in %s%s:" (showDateSpan $ budgetReportSpan budgetr) - (case valueTypeFromOpts ropts of - Just AtTransaction -> ", valued at transaction dates" - Just AtPeriod -> ", valued at period ends" - Just AtNow -> ", current value" - Just (AtDate d) -> ", valued at "++showDate d - Nothing -> "") + (case value_ of + Just (AtCost _mc) -> ", valued at transaction dates" + Just (AtEnd _mc) -> ", valued at period ends" + Just (AtNow _mc) -> ", current value" + Just (AtDate d _mc) -> ", valued at "++showDate d + Nothing -> "") actualwidth = maximum [ maybe 0 (length . showMixedAmountOneLineWithoutPrice) amt | (_, _, _, amtandgoals, _, _) <- rows diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 79c3da8f3..b9cedc1cb 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -35,7 +35,7 @@ type EntriesReportItem = Transaction -- | Select transactions for an entries report. entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport entriesReport opts q j = - (if value_ opts then erValue opts j else id) $ + (if isJust (value_ opts) then erValue opts j else id) $ sortBy (comparing date) $ filter (q `matchesTransaction`) ts where date = transactionDateFn opts @@ -72,14 +72,15 @@ erValue ropts@ReportOpts{..} j ts = map txnvalue ts mperiodorjournallastday = mperiodlastday <|> journalEndDate False j - d = case value_at_ of - AtTransaction -> postingDate p - AtPeriod -> fromMaybe (postingDate p) -- XXX shouldn't happen - mperiodorjournallastday - AtNow -> case today_ of - Just d -> d - Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value-at=now" - AtDate d -> d + d = case value_ of + Just (AtCost _mc) -> postingDate p + Just (AtEnd _mc) -> fromMaybe (postingDate p) -- XXX shouldn't happen + mperiodorjournallastday + Just (AtNow _mc) -> case today_ of + Just d -> d + Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value-at=now" + Just (AtDate d _mc) -> d + Nothing -> error' "erValue: shouldn't happen" -- XXX tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index ecb1027db..7bdf174e5 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -157,19 +157,19 @@ multiBalanceReport ropts@ReportOpts{..} q j = -- transaction: sum/average the valued amounts -- period: sum/average the unvalued amounts and value at report period end -- date: sum/average the unvalued amounts and value at date - mvalueat = valueTypeFromOpts ropts + -- mvalueat = valueTypeFromOpts ropts today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_ -- Market prices. Sort into date then parse order, -- & reverse for quick lookup of the latest price. prices = reverse $ sortOn mpdate $ jmarketprices j -- A helper for valuing amounts according to --value-at. maybevalue :: Day -> MixedAmount -> MixedAmount - maybevalue periodlastday amt = case mvalueat of - Nothing -> amt - Just AtTransaction -> amt -- assume --value-at=transaction was handled earlier - Just AtPeriod -> mixedAmountValue prices periodlastday amt - Just AtNow -> mixedAmountValue prices today amt - Just (AtDate d) -> mixedAmountValue prices d amt + maybevalue periodlastday amt = case value_ of + Nothing -> amt + Just (AtCost _mc) -> amt -- assume --value-at=transaction was handled earlier + Just (AtEnd _mc) -> mixedAmountValue prices periodlastday amt + Just (AtNow _mc) -> mixedAmountValue prices today amt + Just (AtDate d _mc) -> mixedAmountValue prices d amt -- The last day of each column subperiod. lastdays :: [Day] = map ((maybe @@ -187,7 +187,7 @@ multiBalanceReport ropts@ReportOpts{..} q j = -- Balances at report start date, unvalued, from all earlier postings which otherwise match the query. startbals :: [(AccountName, MixedAmount)] = dbg1 "startbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems where - (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts''{value_=False} startbalq j + (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts''{value_=Nothing} startbalq j where ropts' | tree_ ropts = ropts{no_elide_=True} | otherwise = ropts{accountlistmode_=ALFlat} @@ -243,9 +243,9 @@ multiBalanceReport ropts@ReportOpts{..} q j = [(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- colspans] -- If --value-at=transaction is in effect, convert the postings to value before summing. colpsmaybevalued :: [([Posting], Maybe Day)] = - case mvalueat of - Just AtTransaction -> [([postingValueAtDate j (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- colps] - _ -> colps + case value_ of + Just (AtCost _mc) -> [([postingValueAtDate j (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- colps] + _ -> colps ---------------------------------------------------------------------- -- 5. Calculate account balance changes in each column. @@ -325,25 +325,25 @@ multiBalanceReport ropts@ReportOpts{..} q j = HistoricalBalance -> drop 1 $ scanl (+) (valuedStartingBalanceFor a) changes CumulativeChange -> drop 1 $ scanl (+) 0 changes _ -> changes - , let valuedbals = case mvalueat of - Just AtTransaction -> valuedbals1 - Just AtPeriod -> [mixedAmountValue prices periodlastday amt | (amt,periodlastday) <- zip unvaluedbals lastdays] - Just AtNow -> [mixedAmountValue prices today amt | amt <- valuedbals1] - Just (AtDate d) -> [mixedAmountValue prices d amt | amt <- valuedbals1] - _ -> unvaluedbals --value-at=transaction was handled earlier + , let valuedbals = case value_ of + Just (AtCost _mc) -> valuedbals1 + Just (AtEnd _mc) -> [mixedAmountValue prices periodlastday amt | (amt,periodlastday) <- zip unvaluedbals lastdays] + Just (AtNow _mc) -> [mixedAmountValue prices today amt | amt <- valuedbals1] + Just (AtDate d _mc) -> [mixedAmountValue prices d amt | amt <- valuedbals1] + _ -> unvaluedbals --value-at=transaction was handled earlier -- The total and average for the row, and their values. , let rowtot = if balancetype_==PeriodChange then sum unvaluedbals else 0 , let rowavg = averageMixedAmounts unvaluedbals - , let valuedrowtot = case mvalueat of - Just AtPeriod -> mixedAmountValue prices reportlastday rowtot - Just AtNow -> mixedAmountValue prices today rowtot - Just (AtDate d) -> mixedAmountValue prices d rowtot - _ -> rowtot - , let valuedrowavg = case mvalueat of - Just AtPeriod -> mixedAmountValue prices reportlastday rowavg - Just AtNow -> mixedAmountValue prices today rowavg - Just (AtDate d) -> mixedAmountValue prices d rowavg - _ -> rowavg + , let valuedrowtot = case value_ of + Just (AtEnd _mc) -> mixedAmountValue prices reportlastday rowtot + Just (AtNow _mc) -> mixedAmountValue prices today rowtot + Just (AtDate d _mc) -> mixedAmountValue prices d rowtot + _ -> rowtot + , let valuedrowavg = case value_ of + Just (AtEnd _mc) -> mixedAmountValue prices reportlastday rowavg + Just (AtNow _mc) -> mixedAmountValue prices today rowavg + Just (AtDate d _mc) -> mixedAmountValue prices d rowavg + _ -> rowavg , empty_ || depth == 0 || any (not . isZeroMixedAmount) valuedbals ] @@ -399,24 +399,24 @@ multiBalanceReport ropts@ReportOpts{..} q j = colamtsvalued = transpose [bs | (a,_,_,bs,_,_) <- rowsvalued, not (tree_ ropts) || a `elem` highestlevelaccts] coltotals :: [MixedAmount] = dbg1 "coltotals" $ - case mvalueat of - Nothing -> map sum colamts - Just AtTransaction -> map sum colamtsvalued - Just AtPeriod -> map (\(amts,periodlastday) -> maybevalue periodlastday $ sum amts) $ zip colamts lastdays - Just AtNow -> map (maybevalue today . sum) colamts - Just (AtDate d) -> map (maybevalue d . sum) colamts + case value_ of + Nothing -> map sum colamts + Just (AtCost _mc) -> map sum colamtsvalued + Just (AtEnd _mc) -> map (\(amts,periodlastday) -> maybevalue periodlastday $ sum amts) $ zip colamts lastdays + Just (AtNow _mc) -> map (maybevalue today . sum) colamts + Just (AtDate d _mc) -> map (maybevalue d . sum) colamts -- Calculate and maybe value the grand total and average. [grandtotal,grandaverage] = let amts = map ($ map sum colamts) [if balancetype_==PeriodChange then sum else const 0 ,averageMixedAmounts ] - in case mvalueat of - Nothing -> amts - Just AtTransaction -> amts - Just AtPeriod -> map (maybevalue reportlastday) amts - Just AtNow -> map (maybevalue today) amts - Just (AtDate d) -> map (maybevalue d) amts + in case value_ of + Nothing -> amts + Just (AtCost _mc) -> amts + Just (AtEnd _mc) -> map (maybevalue reportlastday) amts + Just (AtNow _mc) -> map (maybevalue today) amts + Just (AtDate d _mc) -> map (maybevalue d) amts -- Totals row. totalsrow :: MultiBalanceReportTotals = dbg1 "totalsrow" (coltotals, grandtotal, grandaverage) diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 7eb942c37..8328c4ca8 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -87,7 +87,6 @@ postingsReport ropts@ReportOpts{..} q j = -- -- "Day before report start" is a bit arbitrary. - mvalueat = valueTypeFromOpts ropts today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_ -- Postings or summary pseudo postings to be displayed. @@ -100,29 +99,29 @@ postingsReport ropts@ReportOpts{..} q j = showempty = empty_ || average_ -- for --value-at=transaction, need to value the postings before summarising them maybevaluedreportps - | mvalueat==Just AtTransaction = [postingValueAtDate j (postingDate p) p | p <- reportps] + -- | value_==Just AtTransaction = [postingValueAtDate j (postingDate p) p | p <- reportps] | otherwise = reportps summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan maybevaluedreportps - in case mvalueat of - Just AtPeriod -> [(postingValueAtDate j periodlastday p , periodend) | (p,periodend) <- summaryps + in case value_ of + Just (AtEnd _mc) -> [(postingValueAtDate j periodlastday p , periodend) | (p,periodend) <- summaryps ,let periodlastday = maybe (error' "postingsReport: expected a subperiod end date") -- XXX shouldn't happen (addDays (-1)) periodend ] - Just AtNow -> [(postingValueAtDate j today p , periodend) | (p,periodend) <- summaryps] - Just (AtDate d) -> [(postingValueAtDate j d p , periodend) | (p,periodend) <- summaryps] + Just (AtNow _mc) -> [(postingValueAtDate j today p , periodend) | (p,periodend) <- summaryps] + Just (AtDate d _mc) -> [(postingValueAtDate j d p , periodend) | (p,periodend) <- summaryps] _ -> summaryps else let reportperiodlastday = fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen $ reportPeriodOrJournalLastDay ropts j - in case mvalueat of + in case value_ of Nothing -> [(p , Nothing) | p <- reportps] - Just AtTransaction -> [(postingValueAtDate j (postingDate p) p , Nothing) | p <- reportps] - Just AtPeriod -> [(postingValueAtDate j reportperiodlastday p, Nothing) | p <- reportps] - Just AtNow -> [(postingValueAtDate j today p , Nothing) | p <- reportps] - Just (AtDate d) -> [(postingValueAtDate j d p , Nothing) | p <- reportps] + Just (AtCost _mc) -> [(postingValueAtDate j (postingDate p) p , Nothing) | p <- reportps] + Just (AtEnd _mc) -> [(postingValueAtDate j reportperiodlastday p, Nothing) | p <- reportps] + Just (AtNow _mc) -> [(postingValueAtDate j today p , Nothing) | p <- reportps] + Just (AtDate d _mc) -> [(postingValueAtDate j d p , Nothing) | p <- reportps] -- posting report items ready for display items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth valuedstartbal runningcalc startnum @@ -137,12 +136,12 @@ postingsReport ropts@ReportOpts{..} q j = -- For --value-at=transaction, we don't bother valuing each -- preceding posting at posting date - how useful would that -- be ? Just value the initial sum/average at report start date. - valuedstartbal = case mvalueat of - Nothing -> startbal - Just AtTransaction -> mixedAmountValue prices daybeforereportstart startbal - Just AtPeriod -> mixedAmountValue prices daybeforereportstart startbal - Just AtNow -> mixedAmountValue prices today startbal - Just (AtDate d) -> mixedAmountValue prices d startbal + valuedstartbal = case value_ of + Nothing -> startbal + Just (AtCost _mc) -> mixedAmountValue prices daybeforereportstart startbal + Just (AtEnd _mc) -> mixedAmountValue prices daybeforereportstart startbal + Just (AtNow _mc) -> mixedAmountValue prices today startbal + Just (AtDate d _mc) -> mixedAmountValue prices d startbal where daybeforereportstart = maybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index a2f219447..a4b85a5ed 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -10,12 +10,11 @@ module Hledger.Reports.ReportOptions ( ReportOpts(..), BalanceType(..), AccountListMode(..), - ValueDate(..), + ValuationType(..), FormatStr, defreportopts, rawOptsToReportOpts, checkReportOpts, - valueTypeFromOpts, flat_, tree_, reportOptsToggleStatus, @@ -38,6 +37,7 @@ module Hledger.Reports.ReportOptions ( reportPeriodOrJournalStart, reportPeriodLastDay, reportPeriodOrJournalLastDay, + valuationTypeIsCost, tests_ReportOptions ) @@ -78,18 +78,16 @@ 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-at=transaction|period|now|DATE. --- ("today" would have been preferable, but clashes with --- "transaction" for abbreviating.) -data ValueDate = - AtTransaction -- ^ Calculate values as of each posting's date (called "transaction" for UI reasons) - | AtPeriod -- ^ Calculate values as of each report period's last day - | AtNow -- ^ Calculate values as of today (report generation date) (called "now" for UI reasons) - | AtDate Day -- ^ Calculate values as of some fixed date +-- | What kind of value conversion should be done on amounts ? +-- UI: --value=cost|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 + | AtEnd (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices at period end(s) + | AtNow (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using current market prices + | AtDate Day (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices on some date deriving (Show,Data,Eq) -- Typeable -instance Default ValueDate where def = AtNow +-- instance Default ValuationType where def = AtNow Nothing -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options @@ -103,9 +101,7 @@ data ReportOpts = ReportOpts { ,period_ :: Period ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched - ,cost_ :: Bool - ,value_ :: Bool -- ^ Should amounts be converted to market value - ,value_at_ :: ValueDate -- ^ Which valuation date should be used for market value + ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ? ,depth_ :: Maybe Int ,display_ :: Maybe DisplayExp -- XXX unused ? ,date2_ :: Bool @@ -171,8 +167,6 @@ defreportopts = ReportOpts def def def - def - def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do @@ -184,9 +178,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,period_ = periodFromRawOpts d rawopts' ,interval_ = intervalFromRawOpts rawopts' ,statuses_ = statusesFromRawOpts rawopts' - ,cost_ = boolopt "cost" rawopts' - ,value_ = or $ map (flip boolopt rawopts') ["value", "value-at"] - ,value_at_ = valueDateFromRawOpts rawopts' + ,value_ = valuationTypeFromRawOpts rawopts' ,depth_ = maybeintopt "depth" rawopts' ,display_ = maybedisplayopt d rawopts' ,date2_ = boolopt "date2" rawopts' @@ -352,19 +344,22 @@ 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 AtNow . catMaybes . map valuedatefromrawopt +valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType +valuationTypeFromRawOpts = lastDef Nothing . filter isJust . map valuationfromrawopt where - valuedatefromrawopt (n,v) - | n == "value-at" = valuedate v - | otherwise = Nothing - valuedate v - | v `elem` ["transaction","t"] = Just AtTransaction - | v `elem` ["period","p"] = Just AtPeriod - | v `elem` ["now","n"] = Just AtNow - | otherwise = flip maybe (Just . AtDate) - (usageError $ "could not parse \""++v++"\" as value date, should be: transaction|period|now|t|p|n|YYYY-MM-DD") - (parsedateM v) + valuationfromrawopt (n,v) + | n == "B" = Just $ AtCost Nothing + | n == "V" = Just $ AtNow Nothing -- TODO: if multiperiod then AtEnd Nothing + | n == "value" = Just $ valuation v + | otherwise = Nothing + valuation v + | v `elem` ["cost","c"] = AtCost Nothing + | v `elem` ["end" ,"e"] = AtEnd Nothing + | v `elem` ["now" ,"n"] = AtNow Nothing + | otherwise = + case parsedateM v of + Just d -> AtDate d Nothing + Nothing -> usageError $ "could not parse \""++v++"\" as value date, should be: transaction|period|now|t|p|n|YYYY-MM-DD" type DisplayExp = String @@ -397,24 +392,20 @@ flat_ = (==ALFlat) . accountlistmode_ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) --- | A simpler way to find the type of valuation to be done, if any. --- Considers the --value and --value-at flagsvalueTypeFromOpts :: ReportOpts -> Maybe ValueDate -valueTypeFromOpts ReportOpts{..} = - case (value_, value_at_) of - (False,_) -> Nothing - -- (True, AtNow) -> Just $ AtDate (fromMaybe (error' "could not satisfy --value-at=now, expected ReportOpts today_ to be set") today_) --- , and converts --value-at=now --- to --value-at=DATE so you don't have to mess with today's date. --- Ie this will never return AtNow. --- (But this is not reflected in the type, or relied on by other code; XXX WIP). - (True, vd) -> Just vd +valuationTypeIsCost :: ReportOpts -> Bool +valuationTypeIsCost ropts = + case value_ ropts of + Just (AtCost _) -> True + _ -> False --- | Convert this journal's postings' amounts to the cost basis amounts if --- specified by options. +-- | Convert this journal's postings' amounts to cost using their +-- transaction prices, if specified by options (-B/--value=cost). +-- Maybe soon superseded by newer valuation code. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal -journalSelectingAmountFromOpts opts - | cost_ opts = journalConvertAmountsToCost - | otherwise = id +journalSelectingAmountFromOpts opts = + case value_ opts of + Just (AtCost _) -> journalConvertAmountsToCost + _ -> id -- | Convert report options and arguments to a query. queryFromOpts :: Day -> ReportOpts -> Query diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 0ebf945a4..ff6c0b449 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -131,6 +131,8 @@ inputflags = [ -- | Common report-related flags: --period, --cost, etc. reportflags :: [Flag RawOpts] reportflags = [ + + -- report period & interval flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "include postings/txns on or after this date" ,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "include postings/txns before this date" ,flagNone ["daily","D"] (setboolopt "daily") "multiperiod/multicolumn report by day" @@ -141,17 +143,45 @@ reportflags = [ ,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "set start date, end date, and/or report interval all at once (overrides the flags above)" ,flagNone ["date2"] (setboolopt "date2") "match the secondary date instead (see command help for other effects)" + -- status/realness/depth/zero filters ,flagNone ["unmarked","U"] (setboolopt "unmarked") "include only unmarked postings/txns (can combine with -P or -C)" ,flagNone ["pending","P"] (setboolopt "pending") "include only pending postings/txns" ,flagNone ["cleared","C"] (setboolopt "cleared") "include only cleared postings/txns" ,flagNone ["real","R"] (setboolopt "real") "include only non-virtual postings" ,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" - ,flagReq ["value-at"] (\s opts -> Right $ setopt "value-at" s opts) "VALUEDATE" "as of which date should market values be calculated ? transaction|period|now|YYYY-MM-DD (implies -V, default: now)" + + -- valuation + ,flagNone ["B","cost"] (setboolopt "B") + "show amounts converted to cost commodity, same as --value=cost" + ,flagNone ["V","market"] (setboolopt "V") + (unwords + ["show amounts converted to default valuation commodity," + ,"same as --value=now (single period reports)" + ,"or --value=end (multiperiod reports)" -- TODO + ]) + -- TODO: -X + -- ,flagReq ["X"] (\s opts -> Right $ setopt "X" s opts) "COMM" + -- (unwords + -- ["show amounts converted to this commodity" + -- ,"same as --value=now,COMM (single period reports)" + -- ,"or --value=end,COMM (multiperiod reports)" + -- ]) + -- ,flagReq ["value"] (\s opts -> Right $ setopt "value" s opts) "TYPE[,COMM]" + ,flagReq ["value"] (\s opts -> Right $ setopt "value" s opts) "TYPE" + (unlines + ["TYPE is cost, end, now, or YYYY-MM-DD." + ,"Show amounts converted to:" + ,"- cost commodity using transaction prices" -- "(then optionally to COMM using market prices at posting date)" + ,"- default valuation commodity using market prices at period end(s)" -- "(or COMM)" + ,"- default valuation commodity using current market prices" + ,"- default valuation commodity using market prices on some date" + ]) + + -- generated postings/transactions ,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" + ] -- | Common output-related flags: --output-file, --output-format... diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 9bb278b3f..f406000f0 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -582,12 +582,12 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = CumulativeChange -> "Ending balances (cumulative)" HistoricalBalance -> "Ending balances (historical)") (showDateSpan $ multiBalanceReportSpan r) - (case valueTypeFromOpts ropts of - Just AtTransaction -> ", valued at transaction dates" - Just AtPeriod -> ", valued at period ends" - Just AtNow -> ", current value" - Just (AtDate d) -> ", valued at "++showDate d - Nothing -> "") + (case value_ of + Just (AtCost _mc) -> ", valued at transaction dates" + Just (AtEnd _mc) -> ", valued at period ends" + Just (AtNow _mc) -> ", current value" + Just (AtDate d _mc) -> ", valued at "++showDate d + Nothing -> "") -- | Build a 'Table' from a multi-column balance report. balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 67f2e6144..5e4570272 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -66,7 +66,7 @@ entriesReportAsText opts = concatMap (showTransactionUnelided . gettxn) -- Original vs inferred transactions/postings were causing problems here, disabling -B (#551). -- Use the explicit one if -B or -x are active. -- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ? - useexplicittxn = boolopt "explicit" (rawopts_ opts) || cost_ (reportopts_ opts) + useexplicittxn = boolopt "explicit" (rawopts_ opts) || (valuationTypeIsCost $ reportopts_ opts) -- Replace this transaction's postings with the original postings if any, but keep the -- current possibly rewritten account names. diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 7a8f73a58..b2a51ddde 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -19,7 +19,7 @@ import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import System.Console.CmdArgs.Explicit as C import Hledger.Read.CsvReader (CSV, printCSV) -import Lucid as L +import Lucid as L hiding (value_) import Text.Tabular as T import Hledger @@ -117,7 +117,7 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = -- | Generate a runnable command from a compound balance command specification. compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) -compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts, rawopts_=rawopts} j = do +compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts@ReportOpts{..}, rawopts_=rawopts} j = do d <- getCurrentDay let -- use the default balance type for this report, unless the user overrides @@ -133,19 +133,19 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r ++ maybe "" (' ':) mtitleclarification ++ valuation where - requestedspan = queryDateSpan (date2_ ropts) userq `spanDefaultsFrom` journalDateSpan (date2_ ropts) j + requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j -- when user overrides, add an indication to the report title mtitleclarification = flip fmap mBalanceTypeOverride $ \t -> case t of PeriodChange -> "(Balance Changes)" CumulativeChange -> "(Cumulative Ending Balances)" HistoricalBalance -> "(Historical Ending Balances)" - valuation = case valueTypeFromOpts ropts of - Just AtTransaction -> ", valued at transaction dates" - Just AtPeriod -> ", valued at period ends" - Just AtNow -> ", current value" - Just (AtDate d) -> ", valued at "++showDate d - Nothing -> "" + valuation = case value_ of + Just (AtCost _mc) -> ", valued at transaction dates" + Just (AtEnd _mc) -> ", valued at period ends" + Just (AtNow _mc) -> ", current value" + Just (AtDate d _mc) -> ", valued at "++showDate d + Nothing -> "" -- Set balance type in the report options. -- Also, use tree mode (by default, at least?) if --cumulative/--historical @@ -154,7 +154,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r -- and tree mode hides this.. or something.. XXX ropts' | not (flat_ ropts) && - interval_ ropts==NoInterval && + interval_==NoInterval && balancetype `elem` [CumulativeChange, HistoricalBalance] = ropts{balancetype_=balancetype, accountlistmode_=ALTree} | otherwise diff --git a/tests/budget/budget.test b/tests/budget/budget.test index 75164d441..c25daa273 100644 --- a/tests/budget/budget.test +++ b/tests/budget/budget.test @@ -338,7 +338,7 @@ P 2018/01/26 SHARE €10 assets:pension €1 assets:bank -$ hledger -f - bal -M --budget --cumulative --forecast --value +$ hledger -f - bal -M --budget --cumulative --forecast -V Budget performance in 2018/05/01-2018/06/30, current value: || May Jun