From c23fc8b671fa323181d0848ec8d286ba10752534 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 23 Apr 2019 17:39:01 -0700 Subject: [PATCH] speed up -V/--value by converting reports, not the journal (#999) Instead of converting all journal amounts to value early on, we now convert just the report amounts to value, before rendering. This was basically how it originally worked (for the balance command), but now it's built in to the four basic reports used by print, register, balance and their variants - Entries, Postings, Balance, MultiBalance - each of which now has its own xxValue helper. This should mostly fix -V's performance when there are many transactions and prices (the price lookups could still be optimised), and allow more flexibility for report-specific value calculations. +------------------------------------------++-----------------+-------------------+--------------------------+ | || hledger.999.pre | hledger.999.1sort | hledger.999.after-report | +==========================================++=================+===================+==========================+ | -f examples/1000x1000x10.journal bal -V || 1.08 | 0.96 | 0.76 | | -f examples/2000x1000x10.journal bal -V || 1.65 | 1.05 | 0.73 | | -f examples/3000x1000x10.journal bal -V || 2.43 | 1.58 | 0.84 | | -f examples/4000x1000x10.journal bal -V || 4.39 | 1.96 | 0.93 | | -f examples/5000x1000x10.journal bal -V || 7.75 | 2.99 | 1.07 | | -f examples/6000x1000x10.journal bal -V || 11.21 | 3.72 | 1.16 | | -f examples/7000x1000x10.journal bal -V || 16.91 | 4.72 | 1.19 | | -f examples/8000x1000x10.journal bal -V || 27.10 | 9.83 | 1.40 | | -f examples/9000x1000x10.journal bal -V || 39.73 | 15.00 | 1.51 | | -f examples/10000x1000x10.journal bal -V || 50.72 | 25.61 | 2.15 | +------------------------------------------++-----------------+-------------------+--------------------------+ There's one new limitation, not yet resolved: -V once again can pick a valuation date in the future, if no report end date is specified and the journal has future-dated transactions. We prefer to avoid that, but reports currently are pure and don't have access to today's date. --- hledger-lib/Hledger/Data/Amount.hs | 12 ++- hledger-lib/Hledger/Reports/BalanceReport.hs | 52 +++++++++---- hledger-lib/Hledger/Reports/EntriesReport.hs | 22 ++++++ .../Hledger/Reports/MultiBalanceReports.hs | 39 ++++++++++ hledger-lib/Hledger/Reports/PostingsReport.hs | 34 +++++++- hledger/Hledger/Cli/Commands/Balance.hs | 9 +-- hledger/Hledger/Cli/Utils.hs | 78 +++++++------------ tests/journal/market-prices.test | 28 ++++++- 8 files changed, 188 insertions(+), 86 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 5371b884e..17c032b19 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -105,7 +105,7 @@ module Hledger.Data.Amount ( isZeroMixedAmount, isReallyZeroMixedAmount, isReallyZeroMixedAmountCost, - -- mixedAmountValue, + mixedAmountValue, mixedAmountTotalPriceToUnitPrice, -- ** rendering styleMixedAmount, @@ -444,7 +444,7 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'} where s' = findWithDefault s c styles --- | Find the market value of this amount on the given date, in it's +-- | Find the market value of this amount on the given date in its -- default valuation commodity, using the given market prices which -- are expected to be in parse order. -- If no default valuation commodity can be found, the amount is left @@ -728,8 +728,12 @@ cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithou canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as --- mixedAmountValue :: MarketPricesDateAndParseOrdered -> Day -> MixedAmount -> MixedAmount --- mixedAmountValue ps d (Mixed as) = Mixed $ map (amountValue ps d) as +-- | Find the market value of each component amount on the given date +-- in its default valuation commodity, using the given market prices +-- which are expected to be in parse order. When no default valuation +-- commodity can be found, amounts are left unchanged. +mixedAmountValue :: [MarketPrice] -> Day -> MixedAmount -> MixedAmount +mixedAmountValue ps d (Mixed as) = Mixed $ map (amountValue ps d) as -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 71d9fdb71..789f312be 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -4,13 +4,6 @@ Balance report, used by the balance command. -} - - - - - - - {-# LANGUAGE FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-} module Hledger.Reports.BalanceReport ( @@ -25,6 +18,7 @@ module Hledger.Reports.BalanceReport ( ) where +import Control.Applicative ((<|>)) import Data.List import Data.Ord import Data.Maybe @@ -37,12 +31,6 @@ import Hledger.Utils import Hledger.Reports.ReportOptions - - - - - - -- | A simple balance report. It has: -- -- 1. a list of items, one per account, each containing: @@ -78,7 +66,8 @@ flatShowsExclusiveBalance = True -- eg this can do hierarchical display). balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReport opts q j = - (if invert_ opts then brNegate else id) $ + (if invert_ opts then brNegate else id) $ + (if value_ opts then brValue opts j else id) $ (sorteditems, total) where -- dbg1 = const id -- exclude from debug output @@ -180,6 +169,39 @@ brNegate (is, tot) = (map brItemNegate is, -tot) where brItemNegate (a, a', d, amt) = (a, a', d, -amt) +-- | Convert all the posting amounts in a BalanceReport to their +-- default valuation commodities. This means using the Journal's most +-- recent applicable market prices before the valuation date. +-- The valuation date is the specified report end date if any, +-- otherwise the journal's end date. +brValue :: ReportOpts -> Journal -> BalanceReport -> BalanceReport +brValue ropts j r = + let mvaluationdate = periodEnd (period_ ropts) <|> journalEndDate False j + in case mvaluationdate of + Nothing -> r + Just d -> r' + where + -- prices are in parse order - sort into date then parse order, + -- & reversed for quick lookup of the latest price. + prices = reverse $ sortOn mpdate $ jmarketprices j + (items,total) = r + r' = + dbg8 "market prices" prices `seq` + dbg8 "valuation date" d `seq` + dbg8 "brValue" + ([(n, n', i, mixedAmountValue prices d a) |(n,n',i,a) <- items], mixedAmountValue prices d total) + +-- -- | Find the best commodity to convert to when asked to show the +-- -- market value of this commodity on the given date. That is, the one +-- -- in which it has most recently been market-priced, ie the commodity +-- -- mentioned in the most recent applicable historical price directive +-- -- before this date. +-- -- defaultValuationCommodity :: Journal -> Day -> CommoditySymbol -> Maybe CommoditySymbol +-- -- defaultValuationCommodity j d c = mpamount <$> commodityValue j d c + + +-- tests + Right samplejournal2 = journalBalanceTransactions False nulljournal{ @@ -203,8 +225,6 @@ Right samplejournal2 = ] } --- tests - tests_BalanceReport = tests "BalanceReport" [ tests "balanceReport" $ let diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 9abdea7c7..deebd02f9 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -14,6 +14,7 @@ module Hledger.Reports.EntriesReport ( ) where +import Control.Applicative ((<|>)) import Data.List import Data.Ord @@ -32,11 +33,32 @@ type EntriesReportItem = Transaction -- | Select transactions for an entries report. entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport entriesReport opts q j = + (if value_ opts then erValue opts j else id) $ sortBy (comparing date) $ filter (q `matchesTransaction`) ts where date = transactionDateFn opts ts = jtxns $ journalSelectingAmountFromOpts opts j +-- | Convert all the posting amounts in an EntriesReport to their +-- default valuation commodities. This means using the Journal's most +-- recent applicable market prices before the valuation date. +-- The valuation date is the specified report end date if any, +-- otherwise the journal's end date. +erValue :: ReportOpts -> Journal -> EntriesReport -> EntriesReport +erValue ropts j ts = + let mvaluationdate = periodEnd (period_ ropts) <|> journalEndDate False j + in case mvaluationdate of + Nothing -> ts + Just d -> map valuetxn ts + where + -- prices are in parse order - sort into date then parse order, + -- & reversed for quick lookup of the latest price. + prices = reverse $ sortOn mpdate $ jmarketprices j + + valuetxn t@Transaction{..} = t{tpostings=map valueposting tpostings} + valueposting p@Posting{..} = p{pamount=mixedAmountValue prices d pamount} + + tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) `is` 1 diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index f782e6918..32407afbc 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -20,6 +20,7 @@ module Hledger.Reports.MultiBalanceReports ( ) where +import Control.Applicative ((<|>)) import Data.List import Data.Maybe import Data.Ord @@ -85,6 +86,7 @@ type ClippedAccountName = AccountName multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport opts q j = (if invert_ opts then mbrNegate else id) $ + (if value_ opts then mbrValue opts j else id) $ MultiBalanceReport (displayspans, sorteditems, totalsrow) where symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q @@ -271,6 +273,43 @@ multiBalanceReportSpan :: MultiBalanceReport -> DateSpan multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) +-- | Convert all the posting amounts in a MultiBalanceReport to their +-- default valuation commodities. This means using the Journal's most +-- recent applicable market prices before the valuation date. +-- The valuation date is the specified report end date if any, +-- otherwise the journal's end date. +mbrValue :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport +mbrValue ropts j r = + let mvaluationdate = periodEnd (period_ ropts) <|> journalEndDate False j + in case mvaluationdate of + Nothing -> r + Just d -> r' + where + -- prices are in parse order - sort into date then parse order, + -- & reversed for quick lookup of the latest price. + prices = reverse $ sortOn mpdate $ jmarketprices j + + MultiBalanceReport (spans, rows, (coltotals, rowtotaltotal, rowavgtotal)) = r + r' = MultiBalanceReport + (spans, + [(acct, acct', depth, map convert rowamts, convert rowtotal, convert rowavg) | (acct, acct', depth, rowamts, rowtotal, rowavg) <- rows], + (map convert coltotals, convert rowtotaltotal, convert rowavgtotal)) + convert = mixedAmountValue prices d + + -- -- convert to value ? + -- -- first get period end date(s) XXX duplicated from multiBalanceReport + -- -- The date span specified by -b/-e/-p options and query args if any. + -- requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ ropts) userq -- XXX userq ok ? + -- -- If the requested span is open-ended, close it using the journal's end dates. + -- -- This can still be the null (open) span if the journal is empty. + -- requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ ropts) j + -- -- The list of interval spans enclosing the requested span. + -- -- This list can be empty if the journal was empty, + -- -- or if hledger-ui has added its special date:-tomorrow to the query + -- -- and all txns are in the future. + -- -- intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ ropts) requestedspan' + + -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, -- in order to support --historical. Does not support tree-mode boring parent eliding. -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 194c9463b..557155710 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -16,6 +16,7 @@ module Hledger.Reports.PostingsReport ( ) where +import Control.Applicative ((<|>)) import Data.List import Data.Maybe import Data.Ord (comparing) @@ -55,7 +56,9 @@ type PostingsReportItem = (Maybe Day -- The posting date, if this is the firs -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport -postingsReport opts q j = (totallabel, items) +postingsReport opts q j = + (if value_ opts then prValue opts j else id) $ + (totallabel, items) where reportspan = adjustReportDates opts q j whichdate = whichDateFromOpts opts @@ -136,9 +139,6 @@ matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) = where dateq = dbg1 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg1 "q" q -- XXX confused by multiple date:/date2: ? -negatePostingAmount :: Posting -> Posting -negatePostingAmount p = p { pamount = negate $ pamount p } - -- | Generate postings report line items from a list of postings or (with -- non-Nothing dates attached) summary postings. postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem] @@ -219,6 +219,32 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps bal = if isclipped a then aibalance else aebalance isclipped a = accountNameLevel a >= depth +negatePostingAmount :: Posting -> Posting +negatePostingAmount p = p { pamount = negate $ pamount p } + +-- -- | Flip the sign of all amounts in a PostingsReport. +-- prNegate :: PostingsReport -> PostingsReport + +-- | Convert all the posting amounts in a PostingsReport to their +-- default valuation commodities. This means using the Journal's most +-- recent applicable market prices before the valuation date. +-- The valuation date is the specified report end date if any, +-- otherwise the journal's end date. +prValue :: ReportOpts -> Journal -> PostingsReport -> PostingsReport +prValue ropts j r = + let mvaluationdate = periodEnd (period_ ropts) <|> journalEndDate False j + in case mvaluationdate of + Nothing -> r + Just d -> r' + where + -- prices are in parse order - sort into date then parse order, + -- & reversed for quick lookup of the latest price. + prices = reverse $ sortOn mpdate $ jmarketprices j + (label,items) = r + r' = (label, [(md,md2,desc,valueposting p, mixedAmountValue prices d amt) | (md,md2,desc,p,amt) <- items]) + valueposting p@Posting{..} = p{pamount=mixedAmountValue prices d pamount} + + -- tests tests_PostingsReport = tests "PostingsReport" [ diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 9a34080c2..b4c41331c 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -308,6 +308,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do let format = outputFormatFromOpts opts budget = boolopt "budget" rawopts interval = interval_ ropts + case (budget, interval) of (True, _) -> do -- single or multicolumn budget report @@ -347,14 +348,6 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do -- rendering single-column balance reports --- | Find the best commodity to convert to when asked to show the --- market value of this commodity on the given date. That is, the one --- in which it has most recently been market-priced, ie the commodity --- mentioned in the most recent applicable historical price directive --- before this date. --- defaultValuationCommodity :: Journal -> Day -> CommoditySymbol -> Maybe CommoditySymbol --- defaultValuationCommodity j d c = mpamount <$> commodityValue j d c - -- | Render a single-column balance report as CSV. balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv opts (items, total) = diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 014e62d5b..465f725ae 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -12,7 +12,6 @@ module Hledger.Cli.Utils withJournalDo, writeOutput, journalTransform, - journalApplyValue, journalAddForecast, journalReload, journalReloadIfChanged, @@ -51,7 +50,6 @@ import Text.Printf import Text.Regex.TDFA ((=~)) import System.Time (ClockTime(TOD)) -import System.TimeIt import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Hledger.Cli.CliOptions @@ -73,17 +71,15 @@ withJournalDo opts cmd = do >>= mapM (journalTransform opts) >>= either error' cmd --- | Apply some transformations to the journal if specified by options. --- These include: +-- | Apply some extra post-parse transformations to the journal, if +-- specified by options. These include: -- -- - adding forecast transactions (--forecast) --- - converting amounts to market value (--value) -- - pivoting account names (--pivot) -- - anonymising (--anonymise). journalTransform :: CliOpts -> Journal -> IO Journal -journalTransform opts@CliOpts{reportopts_=ropts} = +journalTransform opts@CliOpts{reportopts_=_ropts} = journalAddForecast opts - >=> journalApplyValue ropts >=> return . pivotByOpts opts >=> return . anonymiseByOpts opts @@ -119,24 +115,6 @@ anonymise j where anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash --- TODO move journalApplyValue and friends to Hledger.Data.Journal ? They are here because they use ReportOpts - --- | If -V/--value was requested, convert all journal amounts to their market value --- as of the report end date. Cf http://hledger.org/manual.html#market-value --- Since 2017/4 we do this early, before commands run, which affects all commands --- and seems to have the same effect as doing it last on the reported values. -journalApplyValue :: ReportOpts -> Journal -> IO Journal -journalApplyValue ropts j = do - today <- getCurrentDay - mspecifiedenddate <- specifiedEndDate ropts - let d = fromMaybe today mspecifiedenddate - -- prices are in parse order - sort into date then parse order, - -- reversed for quick lookup of the latest price. - ps = reverse $ sortOn mpdate $ jmarketprices j - convert | value_ ropts = overJournalAmounts (amountValue ps d) - | otherwise = id - return $ convert j - -- | Generate periodic transactions from all periodic transaction rules in the journal. -- These transactions are added to the in-memory Journal (but not the on-disk file). -- @@ -149,8 +127,8 @@ journalAddForecast opts@CliOpts{inputopts_=iopts, reportopts_=ropts} j = do today <- getCurrentDay -- "They start on or after the day following the latest normal transaction in the journal, or today if there are none." - let DateSpan _ mjournalend = dbg2 "journalspan" $ journalDateSpan False j -- ignore secondary dates - forecaststart = dbg2 "forecaststart" $ fromMaybe today mjournalend + let mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates + forecaststart = dbg2 "forecaststart" $ fromMaybe today mjournalend -- "They end on or before the specified report end date, or 180 days from today if unspecified." mspecifiedend <- snd . dbg2 "specifieddates" <$> specifiedStartEndDates ropts @@ -303,29 +281,27 @@ backupNumber f g = case g =~ ("^" ++ f ++ "\\.([0-9]+)$") of tests_Cli_Utils = tests "Utils" [ - tests "journalApplyValue" [ - - -- Print the time required to convert one of the sample journals' amounts to value. - -- Pretty clunky, but working. - -- XXX sample.journal has no price records, but is always present. - -- Change to eg examples/5000x1000x10.journal to make this useful. - test "time" $ do - ej <- io $ readJournalFile definputopts "examples/sample.journal" - case ej of - Left e -> crash $ T.pack e - Right j -> do - (t,_) <- io $ timeItT $ do - -- Enable -V, and ensure the valuation date is later than - -- all prices for consistent timing. - let ropts = defreportopts{ - value_=True, - period_=PeriodTo $ parsedate "3000-01-01" - } - j' <- journalApplyValue ropts j - sum (journalAmounts j') `seq` return () - io $ printf "[%.3fs] " t - ok - - ] + -- tests "journalApplyValue" [ + -- -- Print the time required to convert one of the sample journals' amounts to value. + -- -- Pretty clunky, but working. + -- -- XXX sample.journal has no price records, but is always present. + -- -- Change to eg examples/5000x1000x10.journal to make this useful. + -- test "time" $ do + -- ej <- io $ readJournalFile definputopts "examples/3000x1000x10.journal" + -- case ej of + -- Left e -> crash $ T.pack e + -- Right j -> do + -- (t,_) <- io $ timeItT $ do + -- -- Enable -V, and ensure the valuation date is later than + -- -- all prices for consistent timing. + -- let ropts = defreportopts{ + -- value_=True, + -- period_=PeriodTo $ parsedate "3000-01-01" + -- } + -- j' <- journalApplyValue ropts j + -- sum (journalAmounts j') `seq` return () + -- io $ printf "[%.3fs] " t + -- ok + -- ] ] diff --git a/tests/journal/market-prices.test b/tests/journal/market-prices.test index 780ece898..ce81fe06f 100644 --- a/tests/journal/market-prices.test +++ b/tests/journal/market-prices.test @@ -28,16 +28,17 @@ P 2011/01/01 GBP $1.35 $135.00 expenses:foreign >>>=0 -# 3. Market prices in the future are ignored. #453, #683 +# 3. Market prices in the future (later than today's date) are always ignored. #453, #683 +# XXX not working right now hledger -f- bal -N -V <<< P 2000/1/1 $ €1.20 P 3000/1/1 $ €1.30 -3000/01/02 +3000/01/01 (a) $100 >>> - €120.00 a + €130.00 a >>>=0 # 4. The market prices in effect at the report end date are used. @@ -96,3 +97,24 @@ P 2015/08/14 GGGG 32.39 0.48 H >>>=0 +# 7. register: -V affects posting amounts and total. +hledger -f- reg -V +<<< +P 2000/1/1 $ €1.20 +2000/1/1 + (a) $100 +>>> +2000/01/01 (a) €120.00 €120.00 +>>>=0 + +# 8. print: -V affects posting amounts but not balance assertion amounts. +hledger -f- print -V +<<< +P 2000/1/1 $ €1.20 +2000/1/1 + (a) $100 = $100 +>>> +2000/01/01 + (a) €120.00 = $100 + +>>>=0