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

lib: Create mixedAmountApplyValuationAfterSumFromOptsWith for doing any valuation needed after summing amounts.

Browse Source
This commit is contained in:
Stephen Morgan 2021-05-13 20:48:31 +10:00
parent 6fb3dfdbb2
commit 940b2c6ab9
2 changed files with 47 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -42,13 +42,13 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Ord (Down(..)) import Data.Ord (Down(..))
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>)) import Data.Semigroup ((<>))
#endif #endif
import Data.Semigroup (sconcat) import Data.Semigroup (sconcat)
import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Calendar (Day, fromGregorian)
import Safe (lastDef, minimumMay) import Safe (lastDef, minimumMay)
import Hledger.Data import Hledger.Data
@ -115,7 +115,7 @@ multiBalanceReportWith rspec' j priceoracle = report
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
-- Group postings into their columns. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan
-- The matched accounts with a starting balance. All of these should appear -- The matched accounts with a starting balance. All of these should appear
-- in the report, even if they have no postings during the report period. -- in the report, even if they have no postings during the report period.
@ -143,7 +143,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
-- Group postings into their columns. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan
-- The matched accounts with a starting balance. All of these should appear -- The matched accounts with a starting balance. All of these should appear
-- in the report, even if they have no postings during the report period. -- in the report, even if they have no postings during the report period.
@ -191,7 +191,7 @@ startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle repo
fmap (M.findWithDefault nullacct precedingspan) acctmap fmap (M.findWithDefault nullacct precedingspan) acctmap
where where
acctmap = calculateReportMatrix rspec' j priceoracle mempty acctmap = calculateReportMatrix rspec' j priceoracle mempty
. M.singleton precedingspan . map fst $ getPostings rspec' j . M.singleton precedingspan . map fst $ getPostings rspec' j priceoracle
rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'} rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}
-- If we're re-valuing every period, we need to have the unvalued start -- If we're re-valuing every period, we need to have the unvalued start
@ -229,11 +229,11 @@ makeReportQuery rspec reportspan
dateqcons = if date2_ (rsOpts rspec) then Date2 else Date dateqcons = if date2_ (rsOpts rspec) then Date2 else Date
-- | Group postings, grouped by their column -- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn rspec j reportspan = columns getPostingsByColumn rspec j priceoracle reportspan = columns
where where
-- Postings matching the query within the report period. -- Postings matching the query within the report period.
ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle
-- The date spans to be included as report columns. -- The date spans to be included as report columns.
colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan
@ -244,13 +244,13 @@ getPostingsByColumn rspec j reportspan = columns
columns = foldr addPosting emptyMap ps columns = foldr addPosting emptyMap ps
-- | Gather postings matching the query within the report period. -- | Gather postings matching the query within the report period.
getPostings :: ReportSpec -> Journal -> [(Posting, Day)] getPostings :: ReportSpec -> Journal -> PriceOracle -> [(Posting, Day)]
getPostings ReportSpec{rsQuery=query,rsOpts=ropts} = getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle =
map (\p -> (p, date p)) . map (\p -> (p, date p)) .
journalPostings . journalPostings .
filterJournalAmounts symq . -- remove amount parts excluded by cur: filterJournalAmounts symq . -- remove amount parts excluded by cur:
filterJournalPostings reportq . -- remove postings not matched by (adjusted) query filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
journalSelectingAmountFromOpts ropts valuedJournal
where where
symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query
-- The user's query with no depth limit, and expanded to the report span -- The user's query with no depth limit, and expanded to the report span
@ -258,6 +258,8 @@ getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
-- handles the hledger-ui+future txns case above). -- handles the hledger-ui+future txns case above).
reportq = dbg3 "reportq" $ depthless query reportq = dbg3 "reportq" $ depthless query
depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth) depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth)
valuedJournal | isJust (valuationAfterSum ropts) = j
| otherwise = journalApplyValuationFromOptsWith rspec j priceoracle
date = case whichDateFromOpts ropts of date = case whichDateFromOpts ropts of
PrimaryDate -> postingDate PrimaryDate -> postingDate
@ -296,7 +298,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
-- starting-balance-based historical balances. -- starting-balance-based historical balances.
rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of
PeriodChange -> changeamts PeriodChange -> changeamts
CumulativeChange -> cumulativeSum avalue nullacct changeamts CumulativeChange -> cumulative
HistoricalBalance -> historical HistoricalBalance -> historical
where where
-- changes to report on: usually just the changes itself, but use the -- changes to report on: usually just the changes itself, but use the
@ -305,6 +307,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
ChangeReport -> M.mapWithKey avalue changes ChangeReport -> M.mapWithKey avalue changes
BudgetReport -> M.mapWithKey avalue changes BudgetReport -> M.mapWithKey avalue changes
ValueChangeReport -> periodChanges valuedStart historical ValueChangeReport -> periodChanges valuedStart historical
cumulative = cumulativeSum avalue nullacct changeamts
historical = cumulativeSum avalue startingBalance changes historical = cumulativeSum avalue startingBalance changes
startingBalance = HM.lookupDefault nullacct name startbals startingBalance = HM.lookupDefault nullacct name startbals
valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance
@ -313,10 +316,10 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
-- pad with zeros -- pad with zeros
allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)
acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges
colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps
valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps
(pvalue, avalue) = postingAndAccountValuations rspec j priceoracle avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a}
addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id
historicalDate = minimumMay $ mapMaybe spanStart colspans historicalDate = minimumMay $ mapMaybe spanStart colspans
zeros = M.fromList [(span, nullacct) | span <- colspans] zeros = M.fromList [(span, nullacct) | span <- colspans]
@ -554,28 +557,6 @@ cumulativeSum :: (DateSpan -> Account -> Account) -> Account -> Map DateSpan Acc
cumulativeSum value start = snd . M.mapAccumWithKey accumValued start cumulativeSum value start = snd . M.mapAccumWithKey accumValued start
where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s) where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s)
-- | Calculate the Posting and Account valuation functions required by this MultiBalanceReport.
postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle
-> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)
postingAndAccountValuations ReportSpec{rsToday=today, rsOpts=ropts} j priceoracle = case value_ ropts of
-- If we're doing no valuation, just return the identity functions.
Nothing -> (const id, const id)
-- If we're doing AtEnd valuation, we may need to value the same posting at different dates
-- (for example, when preparing a ValueChange report). So we should do valuation on the Accounts.
Just v@(AtEnd _) -> (const id, avalue v)
-- Otherwise, all valuation should be done on the Postings.
Just v -> (pvalue v, const id)
where
-- For a Posting: convert to cost, apply valuation, then strip prices if we don't need them (See issue #1507).
pvalue v span = postingApplyValuation priceoracle styles (end span) today v
-- For an Account: Apply valuation to both the inclusive and exclusive balances.
avalue v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
where value = mixedAmountApplyValuation priceoracle styles (end span) today (error "multiBalanceReport: did not expect amount valuation to be called ") v -- PARTIAL: should not happen
end = maybe (error "multiBalanceReport: expected all spans to have an end date") -- PARTIAL: should not happen
(addDays (-1)) . spanEnd
styles = journalCommodityStyles j
-- tests -- tests
tests_MultiBalanceReport = tests "MultiBalanceReport" [ tests_MultiBalanceReport = tests "MultiBalanceReport" [

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

@ -31,6 +31,8 @@ module Hledger.Reports.ReportOptions (
journalSelectingAmountFromOpts, journalSelectingAmountFromOpts,
journalApplyValuationFromOpts, journalApplyValuationFromOpts,
journalApplyValuationFromOptsWith, journalApplyValuationFromOptsWith,
mixedAmountApplyValuationAfterSumFromOptsWith,
valuationAfterSum,
intervalFromRawOpts, intervalFromRawOpts,
forecastPeriodFromRawOpts, forecastPeriodFromRawOpts,
queryFromFlags, queryFromFlags,
@ -528,18 +530,34 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle =
historical = DateSpan Nothing $ spanStart =<< headMay spans historical = DateSpan Nothing $ spanStart =<< headMay spans
spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec
styles = journalCommodityStyles j styles = journalCommodityStyles j
err = error' "journalApplyValuationFromOpts: expected a non-empty journal" err = error "journalApplyValuationFromOpts: expected all spans to have an end date"
-- | Whether we need to perform valuation after summing amounts, as in a -- | Calculate the Account valuation functions required for valuing after summing amounts.
-- historical report with --value=end. -- Used in MultiBalanceReport to value historical reports and the like.
valuationAfterSum :: ReportOpts -> Bool mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle -> (DateSpan -> MixedAmount -> MixedAmount)
mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = case valuationAfterSum ropts of
Just mc -> \span -> valuation mc span . maybeStripPrices . costing
Nothing -> const id
where
valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span)
where err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"
maybeStripPrices = if show_costs_ ropts then id else mixedAmountStripPrices
costing = case cost_ ropts of
Cost -> styleMixedAmount styles . mixedAmountCost
NoCost -> id
styles = journalCommodityStyles j
-- | If we are performing valuation after summing amounts, return Just the
-- commodity symbols we're converting to, otherwise return Nothing.
-- Used for example with historical reports with --value=end.
valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol)
valuationAfterSum ropts = case value_ ropts of valuationAfterSum ropts = case value_ ropts of
Just (AtEnd _) -> case (reporttype_ ropts, balancetype_ ropts) of Just (AtEnd mc) -> case (reporttype_ ropts, balancetype_ ropts) of
(ValueChangeReport, _) -> True (ValueChangeReport, _) -> Just mc
(_, HistoricalBalance) -> True (_, HistoricalBalance) -> Just mc
(_, CumulativeChange) -> True (_, CumulativeChange) -> Just mc
_ -> False _ -> Nothing
_ -> False _ -> Nothing
-- | Convert report options to a query, ignoring any non-flag command line arguments. -- | Convert report options to a query, ignoring any non-flag command line arguments.