fix(sap): combineBlocks yet another bug squashed

This commit is contained in:
Steffen Jost 2023-10-17 16:56:56 +02:00
parent f4adfdf872
commit 3924d14abd

View File

@ -79,13 +79,13 @@ compileBlocks :: Day -> Day -> [(Day,Bool)] -> [(Day, Day)]
compileBlocks dStart dEnd = go (dStart, True)
where
go :: (Day,Bool) -> [(Day,Bool)] -> [(Day, Day)]
go (d,s) ((d1,s1):r1@((d2,_s2):_r2))
| d1 == d2 || succ d1 == d2 || s == s1 || d1 < d = go (d,s) r1 -- ignore unnecessary change
go (d,s) ((d1,s1):r1)
| s, not s1
, d < d1, d1 < dEnd = (d,d1) : go (d1,s1) r1 -- valid interval found
| s == s1 = go (d ,s ) r1 -- no change
| otherwise = go (d1,s1) r1 -- ignore invalid interval
go b@(d,s) ((d1,s1):r1@((d2,_s2):_r2))
| d1 == d2 || succ d1 == d2 || s == s1 || d1 < d = go b r1 -- ignore unnecessary change
go b@(d,s) ((d1,s1):r1)
| d1 >= dEnd = go b [] -- remaining days extend validity
| s, not s1, d < d1 = (d,d1) : go (d1,s1) r1 -- valid interval found
| s == s1 = go b r1 -- no change
| otherwise = go (d1,s1) r1 -- ignore invalid interval
go (d,s) []
| s = [(d,dEnd)]
| otherwise = []