From cf4029a5ed86e159f000ef69e7c15d3f9ebb19ab Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Wed, 11 Sep 2019 22:48:07 +0100 Subject: [PATCH] lib: fix generation of periodic transactions with days/months/... repeat --- hledger-lib/Hledger/Data/Dates.hs | 22 ------------------- .../Hledger/Data/PeriodicTransaction.hs | 11 ++++++---- 2 files changed, 7 insertions(+), 26 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 6c16d5ac1..20acae22e 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/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 diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 70bbe8cef..153d67e87 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ 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,7 +215,11 @@ 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 -- (from which the span and interval are derived).