diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 4692468ea..f4031f7c9 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -447,7 +447,7 @@ getSheetNewR tid ssh csh = do now <- liftIO getCurrentTime let template = case lastSheets of ((Entity {entityVal=Sheet{..}}):_) -> - let addTime = addWeeks $ max 1 $ succ $ weekDiff sheetActiveTo now + let addTime = addWeeks $ max 1 $ weeksToAdd sheetActiveTo now in Just $ SheetForm { sfName = stepTextCounterCI sheetName , sfDescription = sheetDescription diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 69ace7b97..6e4bbb027 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -6,7 +6,7 @@ module Handler.Utils.DateTime , validDateTimeFormats, dateTimeFormatOptions , formatTimeMail , addOneWeek, addWeeks - , weekDiff + , weekDiff, weeksToAdd ) where import Import @@ -150,5 +150,15 @@ weekDiff old new = dayDiff `div` 7 dayNew = utctDay new dayDiff = diffDays dayNew dayOld +weeksToAdd :: UTCTime -> UTCTime -> Integer +-- ^ Number of weeks needed to add so that first +-- time occurs later than second time +-- (loop avoids off-by-one error with weekDiff corner cases) +weeksToAdd old new = loop 0 old + where + loop n t + | t > new = n + | otherwise = loop (succ n) (addOneWeek t) + -- addOneTerm? -> Move Handler.Utils.DateTime