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

fix(fill): correct term start day guessing

Browse Source
This commit is contained in:
Steffen Jost 2021-09-30 09:41:23 +02:00
parent 30d5af00bf
commit 538aa5b3b9
2 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Model/Types/DateTime.hs
View File

@ -167,10 +167,10 @@ guessDay TermIdentifier{ year, season = Q2 } TermDayStart = fromGregorian year
guessDay TermIdentifier{ year, season = Q3 } TermDayStart = fromGregorian year 7 1
guessDay TermIdentifier{ year, season = Q4 } TermDayStart = fromGregorian year 10 1
guessDay tid TermDayEnd = pred $ guessDay (succ tid) TermDayStart
guessDay tid@TermIdentifier{ year } TermDayLectureStart = fromWeekDate year weekStart 1 -- first Monday within Quarter
where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayStart
guessDay tid@TermIdentifier{ year } TermDayLectureEnd = fromWeekDate year weekStart 5 -- Friday of last week within Quarter
where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayEnd
guessDay tid TermDayLectureStart = fromWeekDate year weekStart 1 -- first Monday within Quarter
where ( year, weekStart, _) = toWeekDate $ guessDay tid TermDayStart
guessDay tid TermDayLectureEnd = fromWeekDate year weekStart 5 -- Friday of last week within Quarter
where ( year, weekStart, _) = toWeekDate $ guessDay tid TermDayEnd
withinTerm :: Day -> TermIdentifier -> Bool
withinTerm d tid = guessDay tid TermDayStart <= d && d <= guessDay tid TermDayEnd

16
test/Database/Fill.hs
View File

@ -66,7 +66,7 @@ fillDb = do
prevTerm = pred currentTerm
prevPrevTerm = pred prevTerm
seasonTerm next wSeason = until (((==) wSeason) . season) prog currentTerm
seasonTerm next wSeason = until ((wSeason ==) . season) prog currentTerm
where prog | next = succ
| otherwise = pred
@ -597,7 +597,7 @@ fillDb = do
|]
, courseLinkExternal = Nothing
, courseShorthand = "F"
, courseTerm = TermKey $ currentTerm
, courseTerm = TermKey currentTerm
, courseSchool = avn
, courseCapacity = Nothing
, courseVisibleFrom = Just now
@ -618,10 +618,10 @@ fillDb = do
forM_ [(Monday)..Thursday] $ \td -> do
forM_ [(1::Int)..(4*4)] $ \tw -> do
let firstTT = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False td (toMorning)
secondTT = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False (succ td) (toMorning)
let firstTT = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False td toMorning
secondTT = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False (succ td) toMorning
tut1 <- insert Tutorial
{ tutorialName = CI.mk $ Text.pack $ "KW" ++ (show $ snd3 $ toWeekDate firstTT) ++ (take 3 $ show td)
{ tutorialName = CI.mk $ Text.pack $ "KW" ++ show (snd3 $ toWeekDate firstTT) ++ take 3 (show td)
, tutorialCourse = fdf
, tutorialType = "Schulung"
, tutorialCapacity = Just 16
@ -647,8 +647,8 @@ fillDb = do
]
}
, tutorialRegGroup = Just "schulung"
, tutorialRegisterFrom = Just $ termTime True (season currentTerm) (toRational $ tw - 9) False td (toMorning)
, tutorialRegisterTo = Just $ termTime True (season currentTerm) (toRational $ tw - 2) False td (toMorning)
, tutorialRegisterFrom = Just $ termTime True (season currentTerm) (toRational $ tw - 9) False td toMorning
, tutorialRegisterTo = Just $ termTime True (season currentTerm) (toRational $ tw - 2) False td toMorning
, tutorialDeregisterUntil = Nothing
, tutorialLastChanged = now
, tutorialTutorControlled = True
@ -951,7 +951,7 @@ fillDb = do
, let uploadEmptyOk = False
]
sheetCombinations = ((,,) <$> shTypes <*> shGroupings <*> shSubModes)
sheetCombinations = (,,) <$> shTypes <*> shGroupings <*> shSubModes
forM_ (zip [0..] sheetCombinations) $ \(shNr, (sheetType, sheetGrouping, sheetSubmissionMode)) -> do
MsgRenderer mr <- getMsgRenderer