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

chore(fill): add exam and sheet to driving lecture

Browse Source
This commit is contained in:
Steffen Jost 2021-09-30 12:36:11 +02:00
parent f1f510c24c
commit 6ec5abf056
1 changed files with 59 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
test/Database/Fill.hs
View File

@ -615,13 +615,35 @@ fillDb = do
, courseDeregisterNoShow = True
}
insert_ $ CourseEdit jost now fdf
void $ insert Sheet
{ sheetCourse = fdf
, sheetName = "Sehtest"
, sheetDescription = Just $ htmlToStoredMarkup [shamlet|Bitte einen Scan ihres Sehtest hochladen!|]
, sheetType = NotGraded
, sheetGrouping = Arbitrary 3
, sheetMarkingText = Nothing
, sheetVisibleFrom = Just $ termTime True (season currentTerm) (-2) False Monday toMidnight
, sheetActiveFrom = Just $ termTime True (season currentTerm) (-2) False Monday toMidnight
, sheetActiveTo = Just $ termTime True (season currentTerm) 0 True Saturday beforeMidnight
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
, sheetHintFrom = Nothing
, sheetSolutionFrom = Nothing
, sheetAutoDistribute = False
, sheetAnonymousCorrection = True
, sheetRequireExamRegistration = Nothing
, sheetAllowNonPersonalisedSubmission = True
, sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
, sheetAuthorshipStatementExam = Nothing
, sheetAuthorshipStatement = Nothing
}
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 = termTime True (season currentTerm) (toRational $ tw - 1) False td toMorning
secondTT = termTime True (season currentTerm) (toRational $ tw - 1) False (succ td) toMorning
regFrom = termTime True (season currentTerm) (toRational $ tw - 8) False td toMorning
regTo = termTime True (season currentTerm) (toRational $ tw - 2) False 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 $ utctDay firstTT) ++ take 3 (show td)
, tutorialCourse = fdf
, tutorialType = "Schulung"
, tutorialCapacity = Just 16
@ -635,25 +657,54 @@ fillDb = do
{ occurrencesScheduled = Set.empty
, occurrencesExceptions = Set.fromList
[ ExceptOccur
{ exceptDay = firstTT
{ exceptDay = utctDay firstTT
, exceptStart = TimeOfDay 8 30 0
, exceptEnd = TimeOfDay 16 0 0
}
, ExceptOccur
{ exceptDay = secondTT
{ exceptDay = utctDay secondTT
, exceptStart = TimeOfDay 9 0 0
, exceptEnd = TimeOfDay 16 0 0
}
]
}
, 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 regFrom
, tutorialRegisterTo = Just regTo
, tutorialDeregisterUntil = Nothing
, tutorialLastChanged = now
, tutorialTutorControlled = True
}
void . insert $ Tutor tut1 jost
void . insert' $ Exam
{ examCourse = fdf
, examName = "Theorie"
, examGradingRule = Nothing
, examBonusRule = Nothing
, examOccurrenceRule = ExamRoomManual
, examExamOccurrenceMapping = Nothing
, examVisibleFrom = Just regFrom
, examRegisterFrom = Just firstTT
, examRegisterTo = Just $ toMidday $ utctDay secondTT
, examDeregisterUntil = Nothing
, examPublishOccurrenceAssignments = Nothing
, examStart = Just $ toTimeOfDay 15 30 0 $ utctDay secondTT
, examEnd = Just $ toTimeOfDay 16 30 0 $ utctDay secondTT
, examFinished = Nothing
, examPartsFrom = Nothing
, examClosed = Nothing
, examPublicStatistics = True
, examGradingMode = ExamGradingPass
, examDescription = Just $ htmlToStoredMarkup [shamlet|Theoretische Prüfung mit Fragebogen|]
, examExamMode = ExamMode
{ examAids = Just $ ExamAidsPreset ExamClosedBook
, examOnline = Just $ ExamOnlinePreset ExamOffline
, examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous
, examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone
}
, examStaff = Just "Jost"
, examAuthorshipStatement = Nothing
}
-- FFP
let nbrs :: [Int]