slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

opts: new -B/--cost, -V/--market, --value flags (#329)

Browse Source
This commit is contained in:
Simon Michael 2019-05-23 00:36:16 -07:00
parent 0b67df2d31
commit f999bf78e6
12 changed files with 169 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hledger-lib/Hledger/Data/Journal.hs
View File

@ -978,7 +978,8 @@ canonicalStyleFrom ss@(first:_) = first {asprecision = prec, asdecimalpoint = md
-- case ps of (MarketPrice{mpamount=a}:_) -> Just a -- case ps of (MarketPrice{mpamount=a}:_) -> Just a
-- _ -> Nothing -- _ -> 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 :: Journal -> Journal
journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where where

14
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -75,13 +75,11 @@ balanceReport ropts@ReportOpts{..} q j =
-- transaction: value each posting at posting date before summing -- transaction: value each posting at posting date before summing
-- period: value totals at period end -- period: value totals at period end
-- date: value totals at date -- date: value totals at date
mvalueat = valueTypeFromOpts ropts
today = fromMaybe (error' "balanceReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_ 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. -- For --value-at=transaction, convert all postings to value before summing them.
-- The report might not use them all but laziness probably helps here. -- The report might not use them all but laziness probably helps here.
j' | mvalueat==Just AtTransaction = j' -- | mvalueat==Just AtTransaction = mapJournalPostings (\p -> postingValueAtDate j (postingDate p) p) j
mapJournalPostings (\p -> postingValueAtDate j (postingDate p) p) j
| otherwise = j | otherwise = j
-- Get all the summed accounts & balances, according to the query, as an account tree. -- Get all the summed accounts & balances, according to the query, as an account tree.
@ -92,11 +90,11 @@ balanceReport ropts@ReportOpts{..} q j =
where where
valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance} valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance}
where where
val = case mvalueat of val = case value_ of
Just AtPeriod -> mixedAmountValue prices periodlastday Just (AtEnd _mc) -> mixedAmountValue prices periodlastday
Just AtNow -> mixedAmountValue prices today Just (AtNow _mc) -> mixedAmountValue prices today
Just (AtDate d) -> mixedAmountValue prices d Just (AtDate d _mc) -> mixedAmountValue prices d
_ -> id _ -> id
where where
-- prices are in parse order - sort into date then parse order, -- prices are in parse order - sort into date then parse order,
-- & reversed for quick lookup of the latest price. -- & reversed for quick lookup of the latest price.

12
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -275,12 +275,12 @@ budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) =
where where
title = printf "Budget performance in %s%s:" title = printf "Budget performance in %s%s:"
(showDateSpan $ budgetReportSpan budgetr) (showDateSpan $ budgetReportSpan budgetr)
(case valueTypeFromOpts ropts of (case value_ of
Just AtTransaction -> ", valued at transaction dates" Just (AtCost _mc) -> ", valued at transaction dates"
Just AtPeriod -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just AtNow -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate d) -> ", valued at "++showDate d Just (AtDate d _mc) -> ", valued at "++showDate d
Nothing -> "") Nothing -> "")
actualwidth = actualwidth =
maximum [ maybe 0 (length . showMixedAmountOneLineWithoutPrice) amt maximum [ maybe 0 (length . showMixedAmountOneLineWithoutPrice) amt
| (_, _, _, amtandgoals, _, _) <- rows | (_, _, _, amtandgoals, _, _) <- rows

19
hledger-lib/Hledger/Reports/EntriesReport.hs
View File

@ -35,7 +35,7 @@ type EntriesReportItem = Transaction
-- | Select transactions for an entries report. -- | Select transactions for an entries report.
entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport
entriesReport opts q j = 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 sortBy (comparing date) $ filter (q `matchesTransaction`) ts
where where
date = transactionDateFn opts date = transactionDateFn opts
@ -72,14 +72,15 @@ erValue ropts@ReportOpts{..} j ts = map txnvalue ts
mperiodorjournallastday = mperiodlastday <|> journalEndDate False j mperiodorjournallastday = mperiodlastday <|> journalEndDate False j
d = case value_at_ of d = case value_ of
AtTransaction -> postingDate p Just (AtCost _mc) -> postingDate p
AtPeriod -> fromMaybe (postingDate p) -- XXX shouldn't happen Just (AtEnd _mc) -> fromMaybe (postingDate p) -- XXX shouldn't happen
mperiodorjournallastday mperiodorjournallastday
AtNow -> case today_ of Just (AtNow _mc) -> case today_ of
Just d -> d Just d -> d
Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value-at=now" Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value-at=now"
AtDate d -> d Just (AtDate d _mc) -> d
Nothing -> error' "erValue: shouldn't happen" -- XXX
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [

78
hledger-lib/Hledger/Reports/MultiBalanceReports.hs
View File

@ -157,19 +157,19 @@ multiBalanceReport ropts@ReportOpts{..} q j =
-- transaction: sum/average the valued amounts -- transaction: sum/average the valued amounts
-- period: sum/average the unvalued amounts and value at report period end -- period: sum/average the unvalued amounts and value at report period end
-- date: sum/average the unvalued amounts and value at date -- 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_ today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_
-- Market prices. Sort into date then parse order, -- Market prices. Sort into date then parse order,
-- & reverse for quick lookup of the latest price. -- & reverse for quick lookup of the latest price.
prices = reverse $ sortOn mpdate $ jmarketprices j prices = reverse $ sortOn mpdate $ jmarketprices j
-- A helper for valuing amounts according to --value-at. -- A helper for valuing amounts according to --value-at.
maybevalue :: Day -> MixedAmount -> MixedAmount maybevalue :: Day -> MixedAmount -> MixedAmount
maybevalue periodlastday amt = case mvalueat of maybevalue periodlastday amt = case value_ of
Nothing -> amt Nothing -> amt
Just AtTransaction -> amt -- assume --value-at=transaction was handled earlier Just (AtCost _mc) -> amt -- assume --value-at=transaction was handled earlier
Just AtPeriod -> mixedAmountValue prices periodlastday amt Just (AtEnd _mc) -> mixedAmountValue prices periodlastday amt
Just AtNow -> mixedAmountValue prices today amt Just (AtNow _mc) -> mixedAmountValue prices today amt
Just (AtDate d) -> mixedAmountValue prices d amt Just (AtDate d _mc) -> mixedAmountValue prices d amt
-- The last day of each column subperiod. -- The last day of each column subperiod.
lastdays :: [Day] = lastdays :: [Day] =
map ((maybe 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. -- 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 startbals :: [(AccountName, MixedAmount)] = dbg1 "startbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems
where where
(startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts''{value_=False} startbalq j (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts''{value_=Nothing} startbalq j
where where
ropts' | tree_ ropts = ropts{no_elide_=True} ropts' | tree_ ropts = ropts{no_elide_=True}
| otherwise = ropts{accountlistmode_=ALFlat} | otherwise = ropts{accountlistmode_=ALFlat}
@ -243,9 +243,9 @@ multiBalanceReport ropts@ReportOpts{..} q j =
[(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- colspans] [(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- colspans]
-- If --value-at=transaction is in effect, convert the postings to value before summing. -- If --value-at=transaction is in effect, convert the postings to value before summing.
colpsmaybevalued :: [([Posting], Maybe Day)] = colpsmaybevalued :: [([Posting], Maybe Day)] =
case mvalueat of case value_ of
Just AtTransaction -> [([postingValueAtDate j (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- colps] Just (AtCost _mc) -> [([postingValueAtDate j (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- colps]
_ -> colps _ -> colps
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- 5. Calculate account balance changes in each column. -- 5. Calculate account balance changes in each column.
@ -325,25 +325,25 @@ multiBalanceReport ropts@ReportOpts{..} q j =
HistoricalBalance -> drop 1 $ scanl (+) (valuedStartingBalanceFor a) changes HistoricalBalance -> drop 1 $ scanl (+) (valuedStartingBalanceFor a) changes
CumulativeChange -> drop 1 $ scanl (+) 0 changes CumulativeChange -> drop 1 $ scanl (+) 0 changes
_ -> changes _ -> changes
, let valuedbals = case mvalueat of , let valuedbals = case value_ of
Just AtTransaction -> valuedbals1 Just (AtCost _mc) -> valuedbals1
Just AtPeriod -> [mixedAmountValue prices periodlastday amt | (amt,periodlastday) <- zip unvaluedbals lastdays] Just (AtEnd _mc) -> [mixedAmountValue prices periodlastday amt | (amt,periodlastday) <- zip unvaluedbals lastdays]
Just AtNow -> [mixedAmountValue prices today amt | amt <- valuedbals1] Just (AtNow _mc) -> [mixedAmountValue prices today amt | amt <- valuedbals1]
Just (AtDate d) -> [mixedAmountValue prices d amt | amt <- valuedbals1] Just (AtDate d _mc) -> [mixedAmountValue prices d amt | amt <- valuedbals1]
_ -> unvaluedbals --value-at=transaction was handled earlier _ -> unvaluedbals --value-at=transaction was handled earlier
-- The total and average for the row, and their values. -- The total and average for the row, and their values.
, let rowtot = if balancetype_==PeriodChange then sum unvaluedbals else 0 , let rowtot = if balancetype_==PeriodChange then sum unvaluedbals else 0
, let rowavg = averageMixedAmounts unvaluedbals , let rowavg = averageMixedAmounts unvaluedbals
, let valuedrowtot = case mvalueat of , let valuedrowtot = case value_ of
Just AtPeriod -> mixedAmountValue prices reportlastday rowtot Just (AtEnd _mc) -> mixedAmountValue prices reportlastday rowtot
Just AtNow -> mixedAmountValue prices today rowtot Just (AtNow _mc) -> mixedAmountValue prices today rowtot
Just (AtDate d) -> mixedAmountValue prices d rowtot Just (AtDate d _mc) -> mixedAmountValue prices d rowtot
_ -> rowtot _ -> rowtot
, let valuedrowavg = case mvalueat of , let valuedrowavg = case value_ of
Just AtPeriod -> mixedAmountValue prices reportlastday rowavg Just (AtEnd _mc) -> mixedAmountValue prices reportlastday rowavg
Just AtNow -> mixedAmountValue prices today rowavg Just (AtNow _mc) -> mixedAmountValue prices today rowavg
Just (AtDate d) -> mixedAmountValue prices d rowavg Just (AtDate d _mc) -> mixedAmountValue prices d rowavg
_ -> rowavg _ -> rowavg
, empty_ || depth == 0 || any (not . isZeroMixedAmount) valuedbals , 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] colamtsvalued = transpose [bs | (a,_,_,bs,_,_) <- rowsvalued, not (tree_ ropts) || a `elem` highestlevelaccts]
coltotals :: [MixedAmount] = coltotals :: [MixedAmount] =
dbg1 "coltotals" $ dbg1 "coltotals" $
case mvalueat of case value_ of
Nothing -> map sum colamts Nothing -> map sum colamts
Just AtTransaction -> map sum colamtsvalued Just (AtCost _mc) -> map sum colamtsvalued
Just AtPeriod -> map (\(amts,periodlastday) -> maybevalue periodlastday $ sum amts) $ zip colamts lastdays Just (AtEnd _mc) -> map (\(amts,periodlastday) -> maybevalue periodlastday $ sum amts) $ zip colamts lastdays
Just AtNow -> map (maybevalue today . sum) colamts Just (AtNow _mc) -> map (maybevalue today . sum) colamts
Just (AtDate d) -> map (maybevalue d . sum) colamts Just (AtDate d _mc) -> map (maybevalue d . sum) colamts
-- Calculate and maybe value the grand total and average. -- Calculate and maybe value the grand total and average.
[grandtotal,grandaverage] = [grandtotal,grandaverage] =
let amts = map ($ map sum colamts) let amts = map ($ map sum colamts)
[if balancetype_==PeriodChange then sum else const 0 [if balancetype_==PeriodChange then sum else const 0
,averageMixedAmounts ,averageMixedAmounts
] ]
in case mvalueat of in case value_ of
Nothing -> amts Nothing -> amts
Just AtTransaction -> amts Just (AtCost _mc) -> amts
Just AtPeriod -> map (maybevalue reportlastday) amts Just (AtEnd _mc) -> map (maybevalue reportlastday) amts
Just AtNow -> map (maybevalue today) amts Just (AtNow _mc) -> map (maybevalue today) amts
Just (AtDate d) -> map (maybevalue d) amts Just (AtDate d _mc) -> map (maybevalue d) amts
-- Totals row. -- Totals row.
totalsrow :: MultiBalanceReportTotals = totalsrow :: MultiBalanceReportTotals =
dbg1 "totalsrow" (coltotals, grandtotal, grandaverage) dbg1 "totalsrow" (coltotals, grandtotal, grandaverage)

33
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -87,7 +87,6 @@ postingsReport ropts@ReportOpts{..} q j =
-- --
-- "Day before report start" is a bit arbitrary. -- "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_ today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_
-- Postings or summary pseudo postings to be displayed. -- Postings or summary pseudo postings to be displayed.
@ -100,29 +99,29 @@ postingsReport ropts@ReportOpts{..} q j =
showempty = empty_ || average_ showempty = empty_ || average_
-- for --value-at=transaction, need to value the postings before summarising them -- for --value-at=transaction, need to value the postings before summarising them
maybevaluedreportps maybevaluedreportps
| mvalueat==Just AtTransaction = [postingValueAtDate j (postingDate p) p | p <- reportps] -- | value_==Just AtTransaction = [postingValueAtDate j (postingDate p) p | p <- reportps]
| otherwise = reportps | otherwise = reportps
summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan maybevaluedreportps summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan maybevaluedreportps
in case mvalueat of in case value_ of
Just AtPeriod -> [(postingValueAtDate j periodlastday p , periodend) | (p,periodend) <- summaryps Just (AtEnd _mc) -> [(postingValueAtDate j periodlastday p , periodend) | (p,periodend) <- summaryps
,let periodlastday = maybe ,let periodlastday = maybe
(error' "postingsReport: expected a subperiod end date") -- XXX shouldn't happen (error' "postingsReport: expected a subperiod end date") -- XXX shouldn't happen
(addDays (-1)) (addDays (-1))
periodend periodend
] ]
Just AtNow -> [(postingValueAtDate j today p , periodend) | (p,periodend) <- summaryps] Just (AtNow _mc) -> [(postingValueAtDate j today p , periodend) | (p,periodend) <- summaryps]
Just (AtDate d) -> [(postingValueAtDate j d p , periodend) | (p,periodend) <- summaryps] Just (AtDate d _mc) -> [(postingValueAtDate j d p , periodend) | (p,periodend) <- summaryps]
_ -> summaryps _ -> summaryps
else else
let reportperiodlastday = let reportperiodlastday =
fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
$ reportPeriodOrJournalLastDay ropts j $ reportPeriodOrJournalLastDay ropts j
in case mvalueat of in case value_ of
Nothing -> [(p , Nothing) | p <- reportps] Nothing -> [(p , Nothing) | p <- reportps]
Just AtTransaction -> [(postingValueAtDate j (postingDate p) p , Nothing) | p <- reportps] Just (AtCost _mc) -> [(postingValueAtDate j (postingDate p) p , Nothing) | p <- reportps]
Just AtPeriod -> [(postingValueAtDate j reportperiodlastday p, Nothing) | p <- reportps] Just (AtEnd _mc) -> [(postingValueAtDate j reportperiodlastday p, Nothing) | p <- reportps]
Just AtNow -> [(postingValueAtDate j today p , Nothing) | p <- reportps] Just (AtNow _mc) -> [(postingValueAtDate j today p , Nothing) | p <- reportps]
Just (AtDate d) -> [(postingValueAtDate j d p , Nothing) | p <- reportps] Just (AtDate d _mc) -> [(postingValueAtDate j d p , Nothing) | p <- reportps]
-- posting report items ready for display -- posting report items ready for display
items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth valuedstartbal runningcalc startnum 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 -- For --value-at=transaction, we don't bother valuing each
-- preceding posting at posting date - how useful would that -- preceding posting at posting date - how useful would that
-- be ? Just value the initial sum/average at report start date. -- be ? Just value the initial sum/average at report start date.
valuedstartbal = case mvalueat of valuedstartbal = case value_ of
Nothing -> startbal Nothing -> startbal
Just AtTransaction -> mixedAmountValue prices daybeforereportstart startbal Just (AtCost _mc) -> mixedAmountValue prices daybeforereportstart startbal
Just AtPeriod -> mixedAmountValue prices daybeforereportstart startbal Just (AtEnd _mc) -> mixedAmountValue prices daybeforereportstart startbal
Just AtNow -> mixedAmountValue prices today startbal Just (AtNow _mc) -> mixedAmountValue prices today startbal
Just (AtDate d) -> mixedAmountValue prices d startbal Just (AtDate d _mc) -> mixedAmountValue prices d startbal
where where
daybeforereportstart = maybe daybeforereportstart = maybe
(error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen

87
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -10,12 +10,11 @@ module Hledger.Reports.ReportOptions (
ReportOpts(..), ReportOpts(..),
BalanceType(..), BalanceType(..),
AccountListMode(..), AccountListMode(..),
ValueDate(..), ValuationType(..),
FormatStr, FormatStr,
defreportopts, defreportopts,
rawOptsToReportOpts, rawOptsToReportOpts,
checkReportOpts, checkReportOpts,
valueTypeFromOpts,
flat_, flat_,
tree_, tree_,
reportOptsToggleStatus, reportOptsToggleStatus,
@ -38,6 +37,7 @@ module Hledger.Reports.ReportOptions (
reportPeriodOrJournalStart, reportPeriodOrJournalStart,
reportPeriodLastDay, reportPeriodLastDay,
reportPeriodOrJournalLastDay, reportPeriodOrJournalLastDay,
valuationTypeIsCost,
tests_ReportOptions tests_ReportOptions
) )
@ -78,18 +78,16 @@ data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typ
instance Default AccountListMode where def = ALDefault instance Default AccountListMode where def = ALDefault
-- | On which date(s) should amount values be calculated ? -- | What kind of value conversion should be done on amounts ?
-- UI: --value-at=transaction|period|now|DATE. -- UI: --value=cost|end|now|DATE[,COMM]
-- ("today" would have been preferable, but clashes with data ValuationType =
-- "transaction" for abbreviating.) AtCost (Maybe CommoditySymbol) -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date
data ValueDate = | AtEnd (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices at period end(s)
AtTransaction -- ^ Calculate values as of each posting's date (called "transaction" for UI reasons) | AtNow (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using current market prices
| AtPeriod -- ^ Calculate values as of each report period's last day | AtDate Day (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices on some date
| AtNow -- ^ Calculate values as of today (report generation date) (called "now" for UI reasons)
| AtDate Day -- ^ Calculate values as of some fixed date
deriving (Show,Data,Eq) -- Typeable 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. -- | Standard options for customising report filtering and output.
-- Most of these correspond to standard hledger command-line options -- Most of these correspond to standard hledger command-line options
@ -103,9 +101,7 @@ data ReportOpts = ReportOpts {
,period_ :: Period ,period_ :: Period
,interval_ :: Interval ,interval_ :: Interval
,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched
,cost_ :: Bool ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ?
,value_ :: Bool -- ^ Should amounts be converted to market value
,value_at_ :: ValueDate -- ^ Which valuation date should be used for market value
,depth_ :: Maybe Int ,depth_ :: Maybe Int
,display_ :: Maybe DisplayExp -- XXX unused ? ,display_ :: Maybe DisplayExp -- XXX unused ?
,date2_ :: Bool ,date2_ :: Bool
@ -171,8 +167,6 @@ defreportopts = ReportOpts
def def
def def
def def
def
def
rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts = checkReportOpts <$> do rawOptsToReportOpts rawopts = checkReportOpts <$> do
@ -184,9 +178,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do
,period_ = periodFromRawOpts d rawopts' ,period_ = periodFromRawOpts d rawopts'
,interval_ = intervalFromRawOpts rawopts' ,interval_ = intervalFromRawOpts rawopts'
,statuses_ = statusesFromRawOpts rawopts' ,statuses_ = statusesFromRawOpts rawopts'
,cost_ = boolopt "cost" rawopts' ,value_ = valuationTypeFromRawOpts rawopts'
,value_ = or $ map (flip boolopt rawopts') ["value", "value-at"]
,value_at_ = valueDateFromRawOpts rawopts'
,depth_ = maybeintopt "depth" rawopts' ,depth_ = maybeintopt "depth" rawopts'
,display_ = maybedisplayopt d rawopts' ,display_ = maybedisplayopt d rawopts'
,date2_ = boolopt "date2" rawopts' ,date2_ = boolopt "date2" rawopts'
@ -352,19 +344,22 @@ reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss}
| s `elem` ss = ropts{statuses_=filter (/= s) ss} | s `elem` ss = ropts{statuses_=filter (/= s) ss}
| otherwise = ropts{statuses_=simplifyStatuses (s:ss)} | otherwise = ropts{statuses_=simplifyStatuses (s:ss)}
valueDateFromRawOpts :: RawOpts -> ValueDate valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valueDateFromRawOpts = lastDef AtNow . catMaybes . map valuedatefromrawopt valuationTypeFromRawOpts = lastDef Nothing . filter isJust . map valuationfromrawopt
where where
valuedatefromrawopt (n,v) valuationfromrawopt (n,v)
| n == "value-at" = valuedate v | n == "B" = Just $ AtCost Nothing
| otherwise = Nothing | n == "V" = Just $ AtNow Nothing -- TODO: if multiperiod then AtEnd Nothing
valuedate v | n == "value" = Just $ valuation v
| v `elem` ["transaction","t"] = Just AtTransaction | otherwise = Nothing
| v `elem` ["period","p"] = Just AtPeriod valuation v
| v `elem` ["now","n"] = Just AtNow | v `elem` ["cost","c"] = AtCost Nothing
| otherwise = flip maybe (Just . AtDate) | v `elem` ["end" ,"e"] = AtEnd Nothing
(usageError $ "could not parse \""++v++"\" as value date, should be: transaction|period|now|t|p|n|YYYY-MM-DD") | v `elem` ["now" ,"n"] = AtNow Nothing
(parsedateM v) | 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 type DisplayExp = String
@ -397,24 +392,20 @@ flat_ = (==ALFlat) . accountlistmode_
-- depthFromOpts :: ReportOpts -> Int -- depthFromOpts :: ReportOpts -> Int
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) -- 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. valuationTypeIsCost :: ReportOpts -> Bool
-- Considers the --value and --value-at flagsvalueTypeFromOpts :: ReportOpts -> Maybe ValueDate valuationTypeIsCost ropts =
valueTypeFromOpts ReportOpts{..} = case value_ ropts of
case (value_, value_at_) of Just (AtCost _) -> True
(False,_) -> Nothing _ -> False
-- (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
-- | Convert this journal's postings' amounts to the cost basis amounts if -- | Convert this journal's postings' amounts to cost using their
-- specified by options. -- transaction prices, if specified by options (-B/--value=cost).
-- Maybe soon superseded by newer valuation code.
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts opts journalSelectingAmountFromOpts opts =
| cost_ opts = journalConvertAmountsToCost case value_ opts of
| otherwise = id Just (AtCost _) -> journalConvertAmountsToCost
_ -> id
-- | Convert report options and arguments to a query. -- | Convert report options and arguments to a query.
queryFromOpts :: Day -> ReportOpts -> Query queryFromOpts :: Day -> ReportOpts -> Query

36
hledger/Hledger/Cli/CliOptions.hs
View File

@ -131,6 +131,8 @@ inputflags = [
-- | Common report-related flags: --period, --cost, etc. -- | Common report-related flags: --period, --cost, etc.
reportflags :: [Flag RawOpts] reportflags :: [Flag RawOpts]
reportflags = [ reportflags = [
-- report period & interval
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "include postings/txns on or after this date" 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" ,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" ,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)" ,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)" ,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 ["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 ["pending","P"] (setboolopt "pending") "include only pending postings/txns"
,flagNone ["cleared","C"] (setboolopt "cleared") "include only cleared postings/txns" ,flagNone ["cleared","C"] (setboolopt "cleared") "include only cleared postings/txns"
,flagNone ["real","R"] (setboolopt "real") "include only non-virtual postings" ,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" ,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 ["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" -- valuation
,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)" ,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 ["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" ,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... -- | Common output-related flags: --output-file, --output-format...

12
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -582,12 +582,12 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
CumulativeChange -> "Ending balances (cumulative)" CumulativeChange -> "Ending balances (cumulative)"
HistoricalBalance -> "Ending balances (historical)") HistoricalBalance -> "Ending balances (historical)")
(showDateSpan $ multiBalanceReportSpan r) (showDateSpan $ multiBalanceReportSpan r)
(case valueTypeFromOpts ropts of (case value_ of
Just AtTransaction -> ", valued at transaction dates" Just (AtCost _mc) -> ", valued at transaction dates"
Just AtPeriod -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just AtNow -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate d) -> ", valued at "++showDate d Just (AtDate d _mc) -> ", valued at "++showDate d
Nothing -> "") Nothing -> "")
-- | Build a 'Table' from a multi-column balance report. -- | Build a 'Table' from a multi-column balance report.
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount

2
hledger/Hledger/Cli/Commands/Print.hs
View File

@ -66,7 +66,7 @@ entriesReportAsText opts = concatMap (showTransactionUnelided . gettxn)
-- Original vs inferred transactions/postings were causing problems here, disabling -B (#551). -- Original vs inferred transactions/postings were causing problems here, disabling -B (#551).
-- Use the explicit one if -B or -x are active. -- Use the explicit one if -B or -x are active.
-- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ? -- 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 -- Replace this transaction's postings with the original postings if any, but keep the
-- current possibly rewritten account names. -- current possibly rewritten account names.

20
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -19,7 +19,7 @@ import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C
import Hledger.Read.CsvReader (CSV, printCSV) import Hledger.Read.CsvReader (CSV, printCSV)
import Lucid as L import Lucid as L hiding (value_)
import Text.Tabular as T import Text.Tabular as T
import Hledger import Hledger
@ -117,7 +117,7 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
-- | Generate a runnable command from a compound balance command specification. -- | Generate a runnable command from a compound balance command specification.
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) 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 d <- getCurrentDay
let let
-- use the default balance type for this report, unless the user overrides -- use the default balance type for this report, unless the user overrides
@ -133,19 +133,19 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
++ maybe "" (' ':) mtitleclarification ++ maybe "" (' ':) mtitleclarification
++ valuation ++ valuation
where 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 -- when user overrides, add an indication to the report title
mtitleclarification = flip fmap mBalanceTypeOverride $ \t -> mtitleclarification = flip fmap mBalanceTypeOverride $ \t ->
case t of case t of
PeriodChange -> "(Balance Changes)" PeriodChange -> "(Balance Changes)"
CumulativeChange -> "(Cumulative Ending Balances)" CumulativeChange -> "(Cumulative Ending Balances)"
HistoricalBalance -> "(Historical Ending Balances)" HistoricalBalance -> "(Historical Ending Balances)"
valuation = case valueTypeFromOpts ropts of valuation = case value_ of
Just AtTransaction -> ", valued at transaction dates" Just (AtCost _mc) -> ", valued at transaction dates"
Just AtPeriod -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just AtNow -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate d) -> ", valued at "++showDate d Just (AtDate d _mc) -> ", valued at "++showDate d
Nothing -> "" Nothing -> ""
-- Set balance type in the report options. -- Set balance type in the report options.
-- Also, use tree mode (by default, at least?) if --cumulative/--historical -- 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 -- and tree mode hides this.. or something.. XXX
ropts' ropts'
| not (flat_ ropts) && | not (flat_ ropts) &&
interval_ ropts==NoInterval && interval_==NoInterval &&
balancetype `elem` [CumulativeChange, HistoricalBalance] balancetype `elem` [CumulativeChange, HistoricalBalance]
= ropts{balancetype_=balancetype, accountlistmode_=ALTree} = ropts{balancetype_=balancetype, accountlistmode_=ALTree}
| otherwise | otherwise

2
tests/budget/budget.test
View File

@ -338,7 +338,7 @@ P 2018/01/26 SHARE €10
assets:pension €1 assets:pension €1
assets:bank 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: Budget performance in 2018/05/01-2018/06/30, current value:
|| May Jun || May Jun