lib: Create mixedAmountApplyValuationAfterSumFromOptsWith for doing any valuation needed after summing amounts.
This commit is contained in:
Stephen Morgan
parent
6fb3dfdbb2
commit
940b2c6ab9
@ -42,13 +42,13 @@ import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
import Data.Ord (Down(..))
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.Time.Calendar (Day, addDays, fromGregorian)
|
||||
import Data.Time.Calendar (Day, fromGregorian)
|
||||
import Safe (lastDef, minimumMay)
|
||||
|
||||
import Hledger.Data
|
||||
@ -115,7 +115,7 @@ multiBalanceReportWith rspec' j priceoracle = report
|
||||
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
where
|
||||
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'}
|
||||
-- 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
|
||||
|
||||
-- | Group postings, grouped by their column
|
||||
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]
|
||||
getPostingsByColumn rspec j reportspan = columns
|
||||
getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> Map DateSpan [Posting]
|
||||
getPostingsByColumn rspec j priceoracle reportspan = columns
|
||||
where
|
||||
-- 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.
|
||||
colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan
|
||||
@ -244,13 +244,13 @@ getPostingsByColumn rspec j reportspan = columns
|
||||
columns = foldr addPosting emptyMap ps
|
||||
|
||||
-- | Gather postings matching the query within the report period.
|
||||
getPostings :: ReportSpec -> Journal -> [(Posting, Day)]
|
||||
getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
|
||||
getPostings :: ReportSpec -> Journal -> PriceOracle -> [(Posting, Day)]
|
||||
getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle =
|
||||
map (\p -> (p, date p)) .
|
||||
journalPostings .
|
||||
filterJournalAmounts symq . -- remove amount parts excluded by cur:
|
||||
filterJournalPostings reportq . -- remove postings not matched by (adjusted) query
|
||||
journalSelectingAmountFromOpts ropts
|
||||
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
|
||||
valuedJournal
|
||||
where
|
||||
symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query
|
||||
-- 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).
|
||||
reportq = dbg3 "reportq" $ depthless query
|
||||
depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth)
|
||||
valuedJournal | isJust (valuationAfterSum ropts) = j
|
||||
| otherwise = journalApplyValuationFromOptsWith rspec j priceoracle
|
||||
|
||||
date = case whichDateFromOpts ropts of
|
||||
PrimaryDate -> postingDate
|
||||
@ -296,7 +298,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
|
||||
-- starting-balance-based historical balances.
|
||||
rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of
|
||||
PeriodChange -> changeamts
|
||||
CumulativeChange -> cumulativeSum avalue nullacct changeamts
|
||||
CumulativeChange -> cumulative
|
||||
HistoricalBalance -> historical
|
||||
where
|
||||
-- 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
|
||||
BudgetReport -> M.mapWithKey avalue changes
|
||||
ValueChangeReport -> periodChanges valuedStart historical
|
||||
cumulative = cumulativeSum avalue nullacct changeamts
|
||||
historical = cumulativeSum avalue startingBalance changes
|
||||
startingBalance = HM.lookupDefault nullacct name startbals
|
||||
valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance
|
||||
@ -313,10 +316,10 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
|
||||
-- pad with zeros
|
||||
allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)
|
||||
acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges
|
||||
colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps
|
||||
valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps
|
||||
colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) 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
|
||||
historicalDate = minimumMay $ mapMaybe spanStart 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
|
||||
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_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
|
||||
@ -31,6 +31,8 @@ module Hledger.Reports.ReportOptions (
|
||||
journalSelectingAmountFromOpts,
|
||||
journalApplyValuationFromOpts,
|
||||
journalApplyValuationFromOptsWith,
|
||||
mixedAmountApplyValuationAfterSumFromOptsWith,
|
||||
valuationAfterSum,
|
||||
intervalFromRawOpts,
|
||||
forecastPeriodFromRawOpts,
|
||||
queryFromFlags,
|
||||
@ -528,18 +530,34 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle =
|
||||
historical = DateSpan Nothing $ spanStart =<< headMay spans
|
||||
spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec
|
||||
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
|
||||
-- historical report with --value=end.
|
||||
valuationAfterSum :: ReportOpts -> Bool
|
||||
-- | Calculate the Account valuation functions required for valuing after summing amounts.
|
||||
-- Used in MultiBalanceReport to value historical reports and the like.
|
||||
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
|
||||
Just (AtEnd _) -> case (reporttype_ ropts, balancetype_ ropts) of
|
||||
(ValueChangeReport, _) -> True
|
||||
(_, HistoricalBalance) -> True
|
||||
(_, CumulativeChange) -> True
|
||||
_ -> False
|
||||
_ -> False
|
||||
Just (AtEnd mc) -> case (reporttype_ ropts, balancetype_ ropts) of
|
||||
(ValueChangeReport, _) -> Just mc
|
||||
(_, HistoricalBalance) -> Just mc
|
||||
(_, CumulativeChange) -> Just mc
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
-- | Convert report options to a query, ignoring any non-flag command line arguments.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user