From 083d9190fd0daf8b054f5d5e38f3a990081aae6d Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 29 Mar 2018 15:50:48 +0100
Subject: [PATCH] budget: only periodic txns with the selected interval are
 used

---
 hledger-lib/Hledger/Data/AutoTransaction.hs  | 12 ++++++++++++
 hledger-lib/Hledger/Reports/ReportOptions.hs |  1 +
 hledger/Hledger/Cli/Commands/Balance.hs      | 19 +++++++++++++------
 3 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs
index daaf73337..706cd1b4a 100644
--- a/hledger-lib/Hledger/Data/AutoTransaction.hs
+++ b/hledger-lib/Hledger/Data/AutoTransaction.hs
@@ -16,6 +16,7 @@ module Hledger.Data.AutoTransaction
     -- * Accessors
     , mtvaluequery
     , jdatespan
+    , periodTransactionInterval
     )
 where
 
@@ -260,3 +261,14 @@ runPeriodicTransaction pt = generate where
             in   
              if d == firstDate then (i,s)
              else error' $ "Unable to generate transactions according to "++(show periodExpr)++" as "++(show d)++" is not a first day of the "++x
+
+-- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ?
+periodTransactionInterval :: PeriodicTransaction -> Maybe Interval
+periodTransactionInterval pt =
+  let
+    expr = ptperiodicexpr pt
+    err  = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr)
+  in
+    case parsePeriodExpr err expr of
+      Left _      -> Nothing
+      Right (i,_) -> Just i
diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs
index 6ac8555eb..d4fa86021 100644
--- a/hledger-lib/Hledger/Reports/ReportOptions.hs
+++ b/hledger-lib/Hledger/Reports/ReportOptions.hs
@@ -19,6 +19,7 @@ module Hledger.Reports.ReportOptions (
   simplifyStatuses,
   whichDateFromOpts,
   journalSelectingAmountFromOpts,
+  intervalFromRawOpts,
   queryFromOpts,
   queryFromOptsOnly,
   queryOptsFromOpts,
diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
index db6da981f..d6afd0ac1 100644
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/hledger/Hledger/Cli/Commands/Balance.hs
@@ -368,14 +368,21 @@ budgetRollUp CliOpts{rawopts_=rawopts} budget j = j { jtxns = remapTxn <$> jtxns
         remapTxn = mapPostings (map remapPosting)
         mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }
 
--- | Generate journal of all periodic transactions in the given journal for the
--- entirety of its history or reporting period, whatever is smaller.
+-- | Select all periodic transactions from the given journal which
+-- match the opts-specified report interval, and use them to generate
+-- budget transactions (like forecast transactions) in the specified
+-- report period.
 budgetJournal :: CliOpts -> Journal -> Journal
-budgetJournal opts j = journalBalanceTransactions' opts j { jtxns = budget }
+budgetJournal opts j = journalBalanceTransactions' opts j { jtxns = budgetts }
   where 
-    dates = spanIntersect (jdatespan j) (periodAsDateSpan $ period_ $ reportopts_ opts)
-    budget = [makeBudget t | pt <- jperiodictxns j, t <- runPeriodicTransaction pt dates]
-    makeBudget t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
+    interval = intervalFromRawOpts $ rawopts_ opts
+    dates    = spanIntersect (jdatespan j) (periodAsDateSpan $ period_ $ reportopts_ opts)
+    budgetts = [makeBudgetTxn t
+               | pt <- jperiodictxns j
+               , periodTransactionInterval pt == Just interval
+               , t <- runPeriodicTransaction pt dates
+               ]
+    makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
     journalBalanceTransactions' opts j =
       let assrt = not . ignore_assertions_ $ inputopts_ opts
       in