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

lib,cli,ui: Separate costing from valuation; each can now be specified

Browse Source 
independently.

You can now combine costing and valuation, for example "--cost
--value=then" will first convert to costs, and then value according to
the "--value=then" strategy. Any valuation strategy can be used with or
without costing.

If multiple valuation and costing strategies are specified on the
command line, then if any of them include costing
(-B/--cost/--value=cost) then amounts will be converted to cost, and for
valuation strategy the rightmost will be used.

--value=cost is deprecated, but still supported and is equivalent to
--cost/-B. --value=cost,COMM is no longer supported, but this behaviour can be
achieved with "--cost --value=then,COMM".
This commit is contained in:
Stephen Morgan 2021-01-26 13:13:11 +11:00 committed by Simon Michael
parent 130739e3ef
commit c9eb7d1bcf
15 changed files with 80 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -58,10 +58,9 @@ data Costing = Cost | NoCost
deriving (Show,Eq)
-- | What kind of value conversion should be done on amounts ?
-- CLI: --value=cost|then|end|now|DATE[,COMM]
-- CLI: --value=then|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
| AtThen (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at each posting's date
AtThen (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at each posting's date
| AtEnd (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at period end(s)
| AtNow (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using current market prices
| AtDate Day (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices on some date
@ -106,7 +105,7 @@ priceDirectiveToMarketPrice PriceDirective{..} =
-- See amountApplyValuation and amountCost.
mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v =
valuation -- . costing
valuation . costing
where
valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v
costing = case cost of
@ -151,8 +150,6 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> Amount -> Amount
amountApplyValuation priceoracle styles periodlast today postingdate v a =
case v of
AtCost Nothing -> styleAmount styles $ amountCost a
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast . styleAmount styles $ amountCost a
AtThen mc -> amountValueAtDate priceoracle styles mc postingdate a
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
AtNow mc -> amountValueAtDate priceoracle styles mc today a

2
hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
View File

@ -111,7 +111,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
periodlast =
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay rspec j
tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) NoCost $ value_ ropts
tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) $ value_ ropts
ts4 =
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
map tval ts3

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

@ -226,8 +226,10 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
(textCell TopLeft) (textCell TopRight) (uncurry showcell) displayTableWithWidths
where
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
<> (case cost_ of
Cost -> ", converted to cost"
NoCost -> "")
<> (case value_ of
Just (AtCost _mc) -> ", valued at cost"
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
@ -284,9 +286,9 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
_ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage
Nothing
where
maybecost = case value_ of
Just (AtCost _) -> mixedAmountCost
_ -> id
maybecost = case cost_ of
Cost -> mixedAmountCost
NoCost -> id
maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id

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

@ -40,7 +40,7 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
where
pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) NoCost value_
pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_
where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
tests_EntriesReport = tests "EntriesReport" [

5
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -575,8 +575,8 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start
postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle
-> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)
postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle
| changingValuation ropts = (const id, avalue' NoCost mv)
| otherwise = (pvalue' NoCost mv, const id)
| changingValuation ropts = (const id, avalue' (cost_ ropts) (value_ ropts))
| otherwise = (pvalue' (cost_ ropts) (value_ ropts), const id)
where
avalue' c v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
where value = mixedAmountApplyCostValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") c v -- PARTIAL: should not happen
@ -584,7 +584,6 @@ postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle
end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date") -- XXX should not happen
. fmap (addDays (-1)) . spanEnd
styles = journalCommodityStyles j
mv = value_ ropts
-- tests

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

@ -76,7 +76,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) NoCost value_
pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_
-- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)]

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

@ -45,7 +45,7 @@ where
import Control.Applicative ((<|>))
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import qualified Data.Text as T
import Data.Time.Calendar (Day, addDays)
import Data.Default (Default(..))
@ -85,6 +85,7 @@ data ReportOpts = ReportOpts {
period_ :: Period
,interval_ :: Interval
,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched
,cost_ :: Costing -- ^ Should we convert amounts to cost, when present?
,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ?
,infer_value_ :: Bool -- ^ Infer market prices from transactions ?
,depth_ :: Maybe Int
@ -134,6 +135,7 @@ defreportopts = ReportOpts
{ period_ = PeriodAll
, interval_ = NoInterval
, statuses_ = []
, cost_ = NoCost
, value_ = Nothing
, infer_value_ = False
, depth_ = Nothing
@ -170,6 +172,7 @@ rawOptsToReportOpts rawopts = do
let colorflag = stringopt "color" rawopts
formatstring = T.pack <$> maybestringopt "format" rawopts
querystring = map T.pack $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
(costing, valuation) = valuationTypeFromRawOpts rawopts
format <- case parseStringFormat <$> formatstring of
Nothing -> return defaultBalanceLineFormat
@ -180,7 +183,8 @@ rawOptsToReportOpts rawopts = do
{period_ = periodFromRawOpts d rawopts
,interval_ = intervalFromRawOpts rawopts
,statuses_ = statusesFromRawOpts rawopts
,value_ = valuationTypeFromRawOpts rawopts
,cost_ = costing
,value_ = valuation
,infer_value_ = boolopt "infer-value" rawopts
,depth_ = maybeposintopt "depth" rawopts
,date2_ = boolopt "date2" rawopts
@ -400,27 +404,29 @@ reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss}
| s `elem` ss = ropts{statuses_=filter (/= s) ss}
| otherwise = ropts{statuses_=simplifyStatuses (s:ss)}
-- | Parse the type of valuation to be performed, if any, specified by
-- -B/--cost, -V, -X/--exchange, or --value flags. If there's more
-- than one of these, the rightmost flag wins.
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts = lastMay . collectopts valuationfromrawopt
-- | Parse the type of valuation and costing to be performed, if any,
-- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is
-- allowed to combine -B/--cost with any other valuation type. If
-- there's more than one valuation type, the rightmost flag wins.
valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType)
valuationTypeFromRawOpts rawopts = (costing, lastMay $ mapMaybe snd valuationopts)
where
costing = if (any ((Cost==) . fst) valuationopts) then Cost else NoCost
valuationopts = collectopts valuationfromrawopt rawopts
valuationfromrawopt (n,v) -- option name, value
| n == "B" = Just $ AtCost Nothing
| n == "V" = Just $ AtEnd Nothing
| n == "X" = Just $ AtEnd (Just $ T.pack v)
| n == "B" = Just (Cost, Nothing)
| n == "V" = Just (NoCost, Just $ AtEnd Nothing)
| n == "X" = Just (NoCost, Just $ AtEnd (Just $ T.pack v))
| n == "value" = Just $ valuation v
| otherwise = Nothing
valuation v
| t `elem` ["cost","c"] = AtCost mc
| t `elem` ["then" ,"t"] = AtThen mc
| t `elem` ["end" ,"e"] = AtEnd mc
| t `elem` ["now" ,"n"] = AtNow mc
| otherwise =
case parsedateM t of
Just d -> AtDate d mc
Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD"
| t `elem` ["cost","c"] = (Cost, usageError "--value=cost,COMM is no longer supported, please specify valuation explicitly, e.g. --cost --value=then,COMM" <$ mc)
| t `elem` ["then" ,"t"] = (NoCost, Just $ AtThen mc)
| t `elem` ["end" ,"e"] = (NoCost, Just $ AtEnd mc)
| t `elem` ["now" ,"n"] = (NoCost, Just $ AtNow mc)
| otherwise = case parsedateM t of
Just d -> (NoCost, Just $ AtDate d mc)
Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD"
where
-- parse --value's value: TYPE[,COMM]
(t,c') = break (==',') v
@ -455,10 +461,9 @@ flat_ = not . tree_
-- transaction prices, if specified by options (-B/--value=cost).
-- Maybe soon superseded by newer valuation code.
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts opts =
case value_ opts of
Just (AtCost _) -> journalToCost
_ -> id
journalSelectingAmountFromOpts opts = case cost_ opts of
Cost -> journalToCost
NoCost -> id
-- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromFlags :: ReportOpts -> Query
@ -476,7 +481,6 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
-- different report periods.
changingValuation :: ReportOpts -> Bool
changingValuation ropts = case value_ ropts of
Just (AtCost (Just _)) -> True
Just (AtEnd _) -> True
_ -> False

2
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -81,7 +81,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
render . defaultLayout toplabel bottomlabel . str
. T.unpack . showTransactionOneLineAmounts
$ transactionApplyCostValuation prices styles periodlast (rsToday rspec) NoCost (value_ ropts) t
$ transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) (value_ ropts) t
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
where
toplabel =

10
hledger-ui/Hledger/UI/UIState.hs
View File

@ -113,7 +113,10 @@ clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=
-- | Toggle between showing the primary amounts or costs.
toggleCost :: UIState -> UIState
toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{value_ = valuationToggleCost $ value_ ropts}}}}}
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{cost_ = toggle $ cost_ ropts}}}}}
where
toggle Cost = NoCost
toggle NoCost = Cost
-- | Toggle between showing primary amounts or default valuation.
toggleValue :: UIState -> UIState
@ -121,11 +124,6 @@ toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rsp
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{
value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}}}
-- | Basic toggling of -B/cost, for hledger-ui.
valuationToggleCost :: Maybe ValuationType -> Maybe ValuationType
valuationToggleCost (Just (AtCost _)) = Nothing
valuationToggleCost _ = Just $ AtCost Nothing
-- | Basic toggling of -V, for hledger-ui.
valuationToggleValue :: Maybe ValuationType -> Maybe ValuationType
valuationToggleValue (Just (AtEnd _)) = Nothing

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

@ -598,14 +598,17 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
PeriodChange -> "Balance changes"
CumulativeChange -> "Ending balances (cumulative)"
HistoricalBalance -> "Ending balances (historical)"
valuationdesc = case value_ of
Just (AtCost _mc) -> ", valued at cost"
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at " <> showDate d
Nothing -> ""
valuationdesc =
(case cost_ of
Cost -> ", converted to cost"
NoCost -> "")
<> (case value_ of
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at " <> showDate d
Nothing -> "")
changingValuation = case (balancetype_, value_) of
(PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval

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

@ -61,7 +61,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
d <- getCurrentDay
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
let
tvalue = transactionApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) NoCost value_
tvalue = transactionApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_
where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
let
ropts = rsOpts rspec

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

@ -139,14 +139,17 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
CumulativeChange -> "(Cumulative Ending Balances)"
HistoricalBalance -> "(Historical Ending Balances)"
valuationdesc = case value_ of
Just (AtCost _mc) -> ", valued at cost"
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
Just (AtDate today _mc) -> ", valued at " <> showDate today
Nothing -> ""
valuationdesc =
(case cost_ of
Cost -> ", converted to cost"
NoCost -> "")
<> (case value_ of
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
Just (AtDate today _mc) -> ", valued at " <> showDate today
Nothing -> "")
changingValuation = case (balancetype_, value_) of
(PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval

8
hledger/test/journal/valuation.test
View File

@ -372,7 +372,7 @@ $ hledger -f- bal -N -V -b 2000
# 34. multicolumn balance report valued at cost
$ hledger -f- bal -MTA --value=cost -b 2000
Balance changes in 2000-01-01..2000-04-30, valued at cost:
Balance changes in 2000-01-01..2000-04-30, converted to cost:
|| Jan Feb Mar Apr Total Average
===++======================================
@ -447,7 +447,7 @@ Period-end value changes in 2000-01-01..2000-04-30:
# February adds 1 A costing 7 B, making 21 B.
# March adds 1 A costing 8 B, making 29 B.
$ hledger -f- bal -M -H -b 200002 --value=cost
Ending balances (historical) in 2000-02-01..2000-04-30, valued at cost:
Ending balances (historical) in 2000-02-01..2000-04-30, converted to cost:
|| 2000-02-29 2000-03-31 2000-04-30
===++====================================
@ -492,7 +492,7 @@ P 2000/04/01 A 4 B
(a) 1 A @ 6 B
$ hledger -f- bal -ME -H -p200001-200004 --value=c
Ending balances (historical) in 2000Q1, valued at cost:
Ending balances (historical) in 2000Q1, converted to cost:
|| 2000-01-31 2000-02-29 2000-03-31
===++====================================
@ -555,7 +555,7 @@ Budget performance in 2000-01-01..2000-04-30:
# 48. budget report, valued at cost.
$ hledger -f- bal -MTA --budget --value=c
Budget performance in 2000-01-01..2000-04-30, valued at cost:
Budget performance in 2000-01-01..2000-04-30, converted to cost:
|| Jan Feb Mar Apr Total Average
===++===============================================================================================================

12
hledger/test/journal/valuation2.test
View File

@ -134,11 +134,11 @@ $ hledger -f- print -B
>=0
# 12. Note the -XZ nullifies the -B here, because both are forms of --value
# (-B -XZ is equivalent to --value=cost --value=end,Z), and the rightmost wins.
# 12. Note the -XZ does not nullify the -B here.
# (-B -XZ is equivalent to --cost --value=end,Z).
$ hledger -f- print -B -XZ
2000-01-01
a -1A @ 1B
a -1B
b 1B
>=0
@ -176,10 +176,10 @@ $ hledger -f- print -B
>=0
# 16.
$ hledger -f- print -B -XZ
$ hledger -f- print -B -XA
2000-01-01
a -1A @ 1B
b 1B
a -1A
b 1A
>=0

2
hledger/test/roi.test
View File

@ -244,7 +244,7 @@ For example, "--value cost,<commodity> --infer-value", where commodity is the on
>>>=1
# 10. Forcing valuation via --value
hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --value cost,A --infer-value
hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --cost --value=then,A --infer-value
<<<
2019/11/01 Example
Assets:Checking -100 A