Fixes #262

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

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