lib: fix generation of periodic transactions with days/months/... repeat

hledger-lib/Hledger/Data/Dates.hs

@@ -60,7 +60,6 @@ module Hledger.Data.Dates (
   spansSpan,
   spanIntersect,
   spansIntersect,
-  spanIntervalIntersect,
   spanDefaultsFrom,
   spanUnion,
   spansUnion,
@@ -263,27 +262,6 @@ spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
       b = latest b1 b2
       e = earliest e1 e2
 
--- | Calculate the intersection of two DateSpans, adjusting the start date so
--- the interval is preserved.
---
--- >>> let intervalIntersect = spanIntervalIntersect (Days 3)
--- >>> mkdatespan "2018-01-01" "2018-01-03" `intervalIntersect` mkdatespan "2018-01-01" "2018-01-05"
--- DateSpan 2018/01/01-2018/01/02
--- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-02" "2018-01-05"
--- DateSpan 2018/01/04
--- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-03" "2018-01-05"
--- DateSpan 2018/01/04
--- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-04" "2018-01-05"
--- DateSpan 2018/01/04
--- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2017-12-01" "2018-01-05"
--- DateSpan 2018/01/01-2018/01/04
-spanIntervalIntersect :: Interval -> DateSpan -> DateSpan -> DateSpan
-spanIntervalIntersect (Days n) (DateSpan (Just b1) e1) sp2@(DateSpan (Just b2) _) =
-      DateSpan (Just b) e1 `spanIntersect` sp2
-    where
-      b = if b1 < b2 then addDays (diffDays b1 b2 `mod` toInteger n) b2 else b1
-spanIntervalIntersect _ sp1 sp2 = sp1 `spanIntersect` sp2
-
 -- | Fill any unspecified dates in the first span with the dates from
 -- the second one. Sort of a one-way spanIntersect.
 spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b

hledger-lib/Hledger/Data/PeriodicTransaction.hs

@@ -24,7 +24,7 @@ import Hledger.Data.Amount
 import Hledger.Data.Posting (post, commentAddTagNextLine)
 import Hledger.Data.Transaction
 import Hledger.Utils.UTF8IOCompat (error')
--- import Hledger.Utils.Debug
+import Hledger.Utils.Debug
 
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -201,9 +201,8 @@ instance Show PeriodicTransaction where
 --
 runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction]
 runPeriodicTransaction PeriodicTransaction{..} requestedspan =
-    [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` spantofill ]
+    [ t{tdate=d} | (DateSpan (Just d) _) <- alltxnspans, spanContainsDate requestedspan d ]
   where
-    spantofill = spanIntervalIntersect ptinterval ptspan requestedspan
     t = nulltransaction{
            tstatus      = ptstatus
           ,tcode        = ptcode
@@ -216,6 +215,10 @@ runPeriodicTransaction PeriodicTransaction{..} requestedspan =
           ,tpostings    = ptpostings
           }
     period = "~ " <> ptperiodexpr
+    -- All spans described by this periodic transaction, where spanStart is event date.
+    -- If transaction does not have start/end date, we set them to start/end of requested span,
+    -- to avoid generating (infinitely) many events. 
+    alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan)
       
 -- | Check that this date span begins at a boundary of this interval,
 -- or return an explanatory error message including the provided period expression