From 42bcbad2fdb408c34e871fcd5fd363734bb84ec0 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 9 Jul 2022 09:59:17 +0100 Subject: [PATCH] imp: bal: budget goals now respect -H (#1879) --- hledger-lib/Hledger/Data/Dates.hs | 9 +++- .../Hledger/Data/PeriodicTransaction.hs | 4 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 41 ++++++++++++++----- hledger/test/balance/budget.test | 30 ++++++++++++++ 4 files changed, 72 insertions(+), 12 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index f97462a77..ff6982513 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -76,7 +76,7 @@ module Hledger.Data.Dates ( daysInSpan, tests_Dates -) +, intervalStartBefore) where import qualified Control.Monad.Fail as Fail (MonadFail, fail) @@ -548,6 +548,13 @@ prevyear = startofyear . addGregorianYearsClip (-1) nextyear = startofyear . addGregorianYearsClip 1 startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day +-- Get the natural start for the given interval that falls on or before the given day. +intervalStartBefore :: Interval -> Day -> Day +intervalStartBefore int d = + case splitSpan int (DateSpan (Just d) (Just $ addDays 1 d)) of + (DateSpan (Just start) _:_) -> start + _ -> d + -- | For given date d find year-long interval that starts on given -- MM/DD of year and covers it. -- The given MM and DD should be basically valid (1-12 & 1-31), diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 40358340b..7eecfcfd3 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -73,7 +73,9 @@ instance Show PeriodicTransaction where --nullperiodictransaction is defined in Types.hs --- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan' +-- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan'. +-- This should be a closed span with both start and end dates specified; +-- an open ended span will generate no transactions. -- -- Note that new transactions require 'txnTieKnot' post-processing. -- The new transactions will have three tags added: diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 8a43148f5..575f8caa8 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.List (find, partition, transpose, foldl') import Data.List.Extra (nubSort) -import Data.Maybe (fromMaybe, catMaybes) +import Data.Maybe (fromMaybe, catMaybes, isJust) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as S @@ -36,6 +36,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB +import Safe (maximumDef, minimumDef) --import System.Console.CmdArgs.Explicit as C --import Lucid as L import qualified Text.Tabular.AsciiWide as Tab @@ -96,27 +97,47 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport | otherwise = budgetgoalreport budgetreport = combineBudgetAndActual ropts j budgetgoalreport' actualreport --- | Use all periodic transactions in the journal to generate --- budget goal transactions in the specified date span. --- Budget goal transactions are similar to forecast transactions except --- their purpose and effect is to define balance change goals, per account and period, --- for BudgetReport. +-- | Use all (or all matched by --budget's argument) periodic transactions in the journal +-- to generate budget goal transactions in the specified date span (and before, to support +-- --historical. The precise start date is the natural start date of the largest interval +-- of the active periodic transaction rules that is on or before the earlier of journal start date, +-- report start date.) +-- Budget goal transactions are similar to forecast transactions except their purpose +-- and effect is to define balance change goals, per account and period, for BudgetReport. +-- journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal journalAddBudgetGoalTransactions bopts ropts reportspan j = either error' id $ journalBalanceTransactions bopts j{ jtxns = budgetts } -- PARTIAL: where - budgetspan = dbg3 "budget span" $ reportspan - pat = fromMaybe "" $ dbg3 "budget pattern" $ T.toLower <$> budgetpat_ ropts + budgetspan = dbg3 "budget span" $ DateSpan mbudgetgoalsstartdate (spanEnd reportspan) + where + mbudgetgoalsstartdate = + -- We want to also generate budget goal txns before the report start date, in case -H is used. + -- What should the actual starting date for goal txns be ? This gets a little tricky: consider a + -- journal with a "~ monthly" periodic transaction rule, where the first transaction is on 1/5. + -- Users will certainly expect a budget goal for january, but "~ monthly" generates transactions + -- on the first of month, and starting from 1/5 would exclude 1/1. + -- Hopefully the following procedure will produce intuitive behaviour in general: + -- from the earlier of the journal start date and the report start date, + -- move backward to the nearest natural start date of the largest period seen among the + -- active periodic transactions (so here: monthly, 1/5 -> 1/1). + case minimumDef Nothing $ filter isJust [journalStartDate False j, spanStart reportspan] of + Nothing -> Nothing + Just d -> Just $ intervalStartBefore biggestinterval d + where + biggestinterval = maximumDef (Days 1) $ map ptinterval budgetpts + -- select periodic transactions matching a pattern -- (the argument of the (final) --budget option). -- XXX two limitations/wishes, requiring more extensive type changes: -- - give an error if pat is non-null and matches no periodic txns -- - allow a regexp or a full hledger query, not just a substring + pat = fromMaybe "" $ dbg3 "budget pattern" $ T.toLower <$> budgetpat_ ropts + budgetpts = [pt | pt <- jperiodictxns j, pat `T.isInfixOf` T.toLower (ptdescription pt)] budgetts = dbg5 "budget goal txns" $ [makeBudgetTxn t - | pt <- jperiodictxns j - , pat `T.isInfixOf` T.toLower (ptdescription pt) + | pt <- budgetpts , t <- runPeriodicTransaction pt budgetspan ] makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" } diff --git a/hledger/test/balance/budget.test b/hledger/test/balance/budget.test index d6b978f61..67f2ddc08 100644 --- a/hledger/test/balance/budget.test +++ b/hledger/test/balance/budget.test @@ -635,3 +635,33 @@ $ hledger -f- bal --budget=weekly -p 2021-01 $ hledger -f- bal --budget=monthly -p 2021-01 > !/aaa/ >= + +# 33. Cumulative budget report. +< +~ monthly + (a) 10 + +2022-01-05 + (a) 10 + +2022-02-03 + (a) 5 + +$ hledger -f- bal --budget -M --cumulative +Budget performance in 2022-01-01..2022-02-28: + + || 2022-01-31 2022-02-28 +===++================================= + a || 10 [100% of 10] 15 [75% of 20] +---++--------------------------------- + || 10 [100% of 10] 15 [75% of 20] + +# 34. Historical budget report. +$ hledger -f- bal --budget -M --historical -b 2022-02-01 +Budget performance in 2022-02: + + || 2022-02-28 +===++================ + a || 15 [75% of 20] +---++---------------- + || 15 [75% of 20]