slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Dmitry Astapov 2019-09-11 22:48:07 +01:00 committed by Simon Michael
parent 2bb6e25390
commit cf4029a5ed
2 changed files with 7 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
hledger-lib/Hledger/Data/Dates.hs
View File

@ -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

11
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -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).