From 5639ea038089a895c8f9bfbad254de124dd7fcae Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 14 Feb 2019 12:11:58 +0100 Subject: [PATCH] bugfix: adding weeks ignores timezone differences --- src/Handler/Utils/DateTime.hs | 33 +++++++++++++-------------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 1d31051fa..4f87bd361 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, 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 \ No newline at end of file + | otherwise = loop (succ n) (addOneWeek t) \ No newline at end of file