bugfix: adding weeks ignores timezone differences

src/Handler/Utils/DateTime.hs

@@ -6,7 +6,7 @@ module Handler.Utils.DateTime
   , validDateTimeFormats, dateTimeFormatOptions
   , formatTimeMail
   , addOneWeek, addWeeks
-  , weekDiff, weeksToAdd
+  , weeksToAdd
   , setYear
   ) where
 
@@ -134,36 +134,29 @@ dateTimeFormatOptions sel = do
   optionsPairs <=< mapM toOption . Set.toList $ validDateTimeFormats tl sel
 
 
+setYear :: Integer -> Day -> Day
+setYear year date = fromGregorian year month day
+  where
+    (_,month,day) = toGregorian date
+
 addOneWeek :: UTCTime -> UTCTime
 addOneWeek = addWeeks 1
 
 addWeeks :: Integer -> UTCTime -> UTCTime
-addWeeks n utct = utct { utctDay = newDay }
+addWeeks n utct = localTimeToUTCTZ appTZ newLocal
   where
-    oldDay = utctDay utct
-    -- newDay = addGregorianDurationRollOver $ stimes n calendarWeek -- only available in newer version 1.9 of Data.Time.Calendar
-    newDay = addDays (7*n) oldDay
+    oldLocal = utcToLocalTime utct
+    oldDay   = localDay oldLocal
+    newDay   = addDays (7*n) oldDay
+    newLocal = oldLocal { localDay = newDay }
 
-weekDiff :: UTCTime -> UTCTime -> Integer
--- ^ Difference between times, rounded down to weeks
-weekDiff old new = dayDiff `div` 7
-  where
-    dayOld  = utctDay old
-    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)
+--   (loop avoids off-by-one error with corner cases)
 weeksToAdd old new = loop 0 old
   where
     loop n t
       | t > new   = n
-      | otherwise = loop (succ n) (addOneWeek t)
-
-
-setYear :: Integer -> Day -> Day
-setYear year date = fromGregorian year month day
-  where
-    (_,month,day) = toGregorian date
+      | otherwise = loop (succ n) (addOneWeek t)