diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 383417a15..b30e9571b 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -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" [ diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 985aeda19..3991d7c8c 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -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.