fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

FIxes #262

Browse Source
This commit is contained in:
SJost 2019-02-05 23:11:31 +01:00
parent 1eb751b5f0
commit 7a684f6cb6
3 changed files with 45 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Handler/Sheet.hs
View File

@ -444,21 +444,24 @@ getSheetNewR tid ssh csh = do
E.orderBy [E.desc (sheet E.^. SheetActiveFrom)] E.orderBy [E.desc (sheet E.^. SheetActiveFrom)]
E.limit 1 E.limit 1
return sheet return sheet
now <- liftIO getCurrentTime
let template = case lastSheets of let template = case lastSheets of
((Entity {entityVal=Sheet{..}}):_) -> Just $ SheetForm ((Entity {entityVal=Sheet{..}}):_) ->
let addTime = addWeeks $ max 1 $ succ $ weekDiff sheetActiveTo now
in Just $ SheetForm
{ sfName = stepTextCounterCI sheetName { sfName = stepTextCounterCI sheetName
, sfDescription = sheetDescription , sfDescription = sheetDescription
, sfType = sheetType , sfType = sheetType
, sfGrouping = sheetGrouping , sfGrouping = sheetGrouping
, sfVisibleFrom = addOneWeek <$> sheetVisibleFrom , sfVisibleFrom = addTime <$> sheetVisibleFrom
, sfActiveFrom = addOneWeek sheetActiveFrom , sfActiveFrom = addTime sheetActiveFrom
, sfActiveTo = addOneWeek sheetActiveTo , sfActiveTo = addTime sheetActiveTo
, sfSubmissionMode = sheetSubmissionMode , sfSubmissionMode = sheetSubmissionMode
, sfUploadMode = sheetUploadMode , sfUploadMode = sheetUploadMode
, sfSheetF = Nothing , sfSheetF = Nothing
, sfHintFrom = addOneWeek <$> sheetHintFrom , sfHintFrom = addTime <$> sheetHintFrom
, sfHintF = Nothing , sfHintF = Nothing
, sfSolutionFrom = addOneWeek <$> sheetSolutionFrom , sfSolutionFrom = addTime <$> sheetSolutionFrom
, sfSolutionF = Nothing , sfSolutionF = Nothing
, sfMarkingF = Nothing , sfMarkingF = Nothing
, sfMarkingText = sheetMarkingText , sfMarkingText = sheetMarkingText

24
src/Handler/Utils/DateTime.hs
View File

@ -5,7 +5,8 @@ module Handler.Utils.DateTime
, getTimeLocale, getDateTimeFormat , getTimeLocale, getDateTimeFormat
, validDateTimeFormats, dateTimeFormatOptions , validDateTimeFormats, dateTimeFormatOptions
, formatTimeMail , formatTimeMail
, addOneWeek , addOneWeek, addWeeks
, weekDiff
) where ) where
import Import import Import
@ -14,7 +15,7 @@ import Data.Time.Zones
import qualified Data.Time.Zones as TZ import qualified Data.Time.Zones as TZ
import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime) import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime)
import Data.Time.Clock (addUTCTime,nominalDay) -- import Data.Time.Clock (addUTCTime,nominalDay)
import qualified Data.Time.Format as Time import qualified Data.Time.Format as Time
import Data.Set (Set) import Data.Set (Set)
@ -132,7 +133,22 @@ dateTimeFormatOptions sel = do
addOneWeek :: UTCTime -> UTCTime addOneWeek :: UTCTime -> UTCTime
addOneWeek = addUTCTime (7 * nominalDay) addOneWeek = addWeeks 1
addWeeks :: Integer -> UTCTime -> UTCTime
addWeeks n utct = utct { utctDay = newDay }
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
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
-- addOneTerm? -> Move Handler.Utils.DateTime -- addOneTerm? -> Move Handler.Utils.DateTime