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

fix(tutorial): fix exam occurrence form

Browse Source 
works better, but still not 100%
some debugging added
This commit is contained in:
Steffen Jost 2025-01-09 19:24:35 +01:00 committed by Sarah Vaupel
parent 11bcef67f8
commit 6cc929e377
9 changed files with 45 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
messages/uniworx/categories/courses/exam/exam/de-de-formal.msg
View File

@ -43,12 +43,13 @@ ExamFormMode: Ausgestaltung der Prüfung
ExamFormGrades: Prüfungsleistungen ExamFormGrades: Prüfungsleistungen
ExamStart: Beginn ExamStart: Beginn
ExamEnd: Ende ExamEnd: Ende
ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe erfolgt pro Prüfungstermin/Raum ExamTimeTip: Nur zur Information, die tatsächliche Zeitangabe erfolgt pro Prüfungstermin/Raum.
ExamTimeFilterTip: In der Kursansicht für Kursverwaltende wird diese Zeit zur Filterung verwendet.
ExamVisibleFrom: Sichtbar ab ExamVisibleFrom: Sichtbar ab
ExamVisibleFromTip: Ohne Datum nie sichtbar und keine Anmeldung möglich ExamVisibleFromTip: Ohne Datum nie sichtbar und keine Anmeldung möglich
ExamRegisterFrom: Anmeldung ab ExamRegisterFrom: Anmeldung ab
ExamRegisterTo: Anmeldung bis ExamRegisterTo: Anmeldung bis
ExamRegisterFromTip: Zeitpunkt ab dem sich Kursartteilnehmer:innen selbständig zur Prüfung anmelden können; ohne Datum ist keine Anmeldung möglich ExamRegisterFromTip: Zeitpunkt ab dem sich Kursartteilnehmer:innen selbständig zur Prüfung anmelden können; ohne Datum ist keine selbständige Anmeldung möglich
ExamDeregisterUntil: Abmeldung bis ExamDeregisterUntil: Abmeldung bis
ExamPublishOccurrenceAssignments: Termin- bzw. Raumzuteilung den Teilnehmer:innen mitteilen um ExamPublishOccurrenceAssignments: Termin- bzw. Raumzuteilung den Teilnehmer:innen mitteilen um
ExamPublishOccurrenceAssignmentsTip: Ab diesem Zeitpunkt können Teilnehmer:innen einsehen zu welcher Teilprüfung bzw. welchen Raum sie angemeldet sind ExamPublishOccurrenceAssignmentsTip: Ab diesem Zeitpunkt können Teilnehmer:innen einsehen zu welcher Teilprüfung bzw. welchen Raum sie angemeldet sind

5
messages/uniworx/categories/courses/exam/exam/en-eu.msg
View File

@ -43,12 +43,13 @@ ExamFormMode: Exam design
ExamFormGrades: Exam achievements ExamFormGrades: Exam achievements
ExamStart: Start ExamStart: Start
ExamEnd: End ExamEnd: End
ExamTimeTip: Only for informational purposes. The actual times are set for each occurrence/room ExamTimeTip: Only for informational purposes. The actual times are set for each occurrence/room.
ExamTimeFilterTip: Also used for Filtering in the course administrator course view.
ExamVisibleFrom: Visible from ExamVisibleFrom: Visible from
ExamVisibleFromTip: If left empty the exam is never visible and course type participants may not register. ExamVisibleFromTip: If left empty the exam is never visible and course type participants may not register.
ExamRegisterFrom: Register from ExamRegisterFrom: Register from
ExamRegisterTo: Register to ExamRegisterTo: Register to
ExamRegisterFromTip: Start of the period in which course type participants may register themselves for the exam. If left empty participants are never allowed to register. ExamRegisterFromTip: Start of the period in which course type participants may register themselves for the exam. If left empty participants are never allowed to register themselves.
ExamDeregisterUntil: Deregister until ExamDeregisterUntil: Deregister until
ExamPublishOccurrenceAssignments: Publish occurrence/room-assignments ExamPublishOccurrenceAssignments: Publish occurrence/room-assignments
ExamPublishOccurrenceAssignmentsTip: At this time participants can find out to which occurrence/room they are assigned ExamPublishOccurrenceAssignmentsTip: At this time participants can find out to which occurrence/room they are assigned

12
src/Handler/Exam/Form.hs
View File

@ -129,15 +129,15 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
<$> areq ciField (fslpI MsgTableExamName (mr MsgTableExamName) & setTooltip MsgExamNameTip) (efName <$> template) <$> areq ciField (fslpI MsgTableExamName (mr MsgTableExamName) & setTooltip MsgExamNameTip) (efName <$> template)
<*> aopt htmlField (fslI MsgExamDescription) (efDescription <$> template) <*> aopt htmlField (fslI MsgExamDescription) (efDescription <$> template)
<* aformSection MsgExamFormTimes <* aformSection MsgExamFormTimes
<*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template) <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip (someMessages [MsgExamTimeTip,MsgExamTimeFilterTip])) (efStart <$> template)
<*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip MsgExamTimeTip) (efEnd <$> template) <*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip (someMessages [MsgExamTimeTip,MsgExamTimeFilterTip])) (efEnd <$> template)
<*> aopt utcTimeField (fslpI MsgExamVisibleFrom (mr MsgDate) & setTooltip MsgExamVisibleFromTip) (efVisibleFrom <$> template) <*> aopt utcTimeField (fslpI MsgExamVisibleFrom (mr MsgDate) & setTooltip MsgExamVisibleFromTip ) (efVisibleFrom <$> template)
<*> aopt utcTimeField (fslpI MsgExamRegisterFrom (mr MsgDate) & setTooltip MsgExamRegisterFromTip) (efRegisterFrom <$> template) <*> aopt utcTimeField (fslpI MsgExamRegisterFrom (mr MsgDate) & setTooltip MsgExamRegisterFromTip) (efRegisterFrom <$> template)
<*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template) <*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template)
<*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template) <*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template)
<*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template) <*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template)
<*> aopt utcTimeField (fslpI MsgExamPartsFrom (mr MsgDate) & setTooltip MsgExamPartsFromTip) (efPartsFrom <$> template) <*> aopt utcTimeField (fslpI MsgExamPartsFrom (mr MsgDate) & setTooltip MsgExamPartsFromTip) (efPartsFrom <$> template)
<*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip (bool MsgExamFinishedTip MsgExamFinishedTipCloseOnFinished $ is _ExamCloseOnFinished' schoolExamCloseMode)) (efFinished <$> template) <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip (bool MsgExamFinishedTip MsgExamFinishedTipCloseOnFinished $ is _ExamCloseOnFinished' schoolExamCloseMode)) (efFinished <$> template)
<* aformSection MsgExamFormOccurrences <* aformSection MsgExamFormOccurrences
<*> examOccurrenceMultiForm (efOccurrences <$> template) <*> examOccurrenceMultiForm (efOccurrences <$> template)
<* aformSection MsgExamFormAutomaticFunctions <* aformSection MsgExamFormAutomaticFunctions

13
src/Handler/Tutorial/Users.hs
View File

@ -54,8 +54,8 @@ mkExamOccurrenceForm exs eom = renderAForm FormStandard maa
let (cuEoIds, eos) = munzip $ Map.lookup eId eid2eos let (cuEoIds, eos) = munzip $ Map.lookup eId eid2eos
in (,,) in (,,)
<$ for_ eDescr (aformInfoWidget . toWgt) <$ for_ eDescr (aformInfoWidget . toWgt)
<*> areq hiddenField "" (Just cueId) <*> apreq hiddenField "" (Just cueId)
<*> areq (mkSetField hiddenField) "" cuEoIds <*> apreq (mkSetField hiddenField) "" cuEoIds
<*> examOccurrenceMultiForm eos <*> examOccurrenceMultiForm eos
) )
@ -127,7 +127,7 @@ postTUsersR tid ssh csh tutn = do
qualOptions = qualificationsOptionList qualifications qualOptions = qualificationsOptionList qualifications
lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped' lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped'
timespan = lessonTimesSpan lessons timespan = lessonTimesSpan lessons
exOccs <- flip foldMapM timespan $ getDayExamOccurrences True ssh $ Just cid exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid
let let
acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData) acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
acts = Map.fromList $ acts = Map.fromList $
@ -221,8 +221,9 @@ postTUsersR tid ssh csh tutn = do
Just act -> act -- execute action and return produced content Just act -> act -- execute action and return produced content
Nothing -> do -- no table action, continue normally Nothing -> do -- no table action, continue normally
let (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan let (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
$logInfoS "ExamOccurrenceForm" [st|Exam from #{tshow tbegin} until #{tshow tend}.|]
(openExams, tutors) <- runDBRead $ (,) (openExams, tutors) <- runDBRead $ (,)
<$> selectList ([ExamCourse ==. cid, ExamStart <=. tbegin] ++ ([ExamEnd >=. tend] ||. [ExamEnd ==. Nothing])) [Asc ExamName] <$> selectList ([ExamCourse ==. cid, ExamStart <=. tend] ++ ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing])) [Asc ExamName]
<*> E.select (do <*> E.select (do
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
`E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId) `E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
@ -236,7 +237,7 @@ postTUsersR tid ssh csh tutn = do
in return $(i18nWidgetFile "exam-missing") in return $(i18nWidgetFile "exam-missing")
else do else do
openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k} -> (ent,) <$> encrypt k openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k} -> (ent,) <$> encrypt k
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm FIDGeneralTutorialAction $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm FIDGeneralTutorialAction $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation
let gtaAnchor = "general-tutorial-action-form" :: Text let gtaAnchor = "general-tutorial-action-form" :: Text
gtaRoute = croute :#: gtaAnchor gtaRoute = croute :#: gtaAnchor
gtaForm = wrapForm gtaWgt FormSettings gtaForm = wrapForm gtaWgt FormSettings
@ -247,10 +248,12 @@ postTUsersR tid ssh csh tutn = do
, formSubmit = FormSubmit , formSubmit = FormSubmit
, formAnchor = Just gtaAnchor , formAnchor = Just gtaAnchor
} }
$logInfoS "ExamOccurrenceEdit" $ tshow (Set.map (eofName &&& eofId) . trd3 <$> gtaRes)
formResult gtaRes $ \(cEId, cEOIds, occs) -> do -- (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm) formResult gtaRes $ \(cEId, cEOIds, occs) -> do -- (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)
let ceoidsDelete = cEOIds `Set.difference` setMapMaybe eofId occs let ceoidsDelete = cEOIds `Set.difference` setMapMaybe eofId occs
eId <- decrypt cEId eId <- decrypt cEId
eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete
$logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length cEOIds} old occurrences, #{length eoIdsDelete} to delete, #{length $ Set.filter (isNothing . eofId) occs} to insert, #{length $ Set.filter (isJust . eofId) occs} to edit|]
runDB do runDB do
deleteWhere [ExamOccurrenceExam ==. eId, ExamOccurrenceId <-. eoIdsDelete] deleteWhere [ExamOccurrenceExam ==. eId, ExamOccurrenceId <-. eoIdsDelete]
upsertExamOccurrences eId $ Set.toList occs upsertExamOccurrences eId $ Set.toList occs

7
src/Handler/Utils/Course/Cache.hs
View File

@ -147,12 +147,13 @@ getDayExamOccurrences onlyOpen ssh mbcid dlimit@(dstart, dend)
`E.innerJoin` E.table @Exam `E.on` (\(crs :& exm) -> crs E.^. CourseId E.==. exm E.^. ExamCourse) `E.innerJoin` E.table @Exam `E.on` (\(crs :& exm) -> crs E.^. CourseId E.==. exm E.^. ExamCourse)
`E.innerJoin` E.table @ExamOccurrence `E.on` (\(_ :& exm :& occ) -> exm E.^. ExamId E.==. occ E.^. ExamOccurrenceExam) `E.innerJoin` E.table @ExamOccurrence `E.on` (\(_ :& exm :& occ) -> exm E.^. ExamId E.==. occ E.^. ExamOccurrenceExam)
E.where_ $ E.and $ catMaybes E.where_ $ E.and $ catMaybes
[ toMaybe onlyOpen $ E.justVal now E.>=. exm E.^. ExamStart -- fail on null [ toMaybe onlyOpen $ E.justVal now E.>=. exm E.^. ExamRegisterFrom -- fail on null
E.&&. E.val now E.<~. exm E.^. ExamEnd -- success on null E.&&. E.val now E.<~. exm E.^. ExamRegisterTo -- success on null
, mbcid <&> ((E.==. (crs E.^. CourseId)) . E.val) , mbcid <&> ((E.==. (crs E.^. CourseId)) . E.val)
, Just $ crs E.^. CourseSchool E.==. E.val ssh , Just $ crs E.^. CourseSchool E.==. E.val ssh
, Just $ E.withinPeriod dlimit (occ E.^. ExamOccurrenceStart) (occ E.^. ExamOccurrenceEnd) , Just $ E.withinPeriod dlimit (occ E.^. ExamOccurrenceStart) (occ E.^. ExamOccurrenceEnd)
] ]
-- E.orderBy [E.asc $ exm E.^. ExamName] -- we return a map, so the order does not matter
return (occ, exm E.^. ExamId, exm E.^. ExamName) -- No Binary instance for Entity Exam, so we only extract what is needed for now return (occ, exm E.^. ExamId, exm E.^. ExamName) -- No Binary instance for Entity Exam, so we only extract what is needed for now
foldMapM mkOccMap candidates foldMapM mkOccMap candidates
where where
@ -160,7 +161,7 @@ getDayExamOccurrences onlyOpen ssh mbcid dlimit@(dstart, dend)
mkOccMap (Entity{..}, E.Value eId, E.Value eName) = encrypt entityKey <&> (\ceoId -> Map.singleton entityKey (entityVal, ceoId, (eId, eName))) mkOccMap (Entity{..}, E.Value eId, E.Value eName) = encrypt entityKey <&> (\ceoId -> Map.singleton entityKey (entityVal, ceoId, (eId, eName)))
mkExamOccurrenceOptions :: ExamOccurrenceMap -> OptionList ExamOccurrenceId mkExamOccurrenceOptions :: ExamOccurrenceMap -> OptionList ExamOccurrenceId
mkExamOccurrenceOptions = mkOptionListGrouped . groupSort . map mkEOOption . Map.toList mkExamOccurrenceOptions = mkOptionListGrouped . map (over _2 $ sortBy (compare `on` optionDisplay)) . groupSort . map mkEOOption . Map.toList
where where
mkEOOption :: (ExamOccurrenceId, (ExamOccurrence, CryptoUUIDExamOccurrence, (ExamId, ExamName))) -> (Text, [Option ExamOccurrenceId]) mkEOOption :: (ExamOccurrenceId, (ExamOccurrence, CryptoUUIDExamOccurrence, (ExamId, ExamName))) -> (Text, [Option ExamOccurrenceId])
mkEOOption (eid, (ExamOccurrence{examOccurrenceName}, ceoId, (_,eName))) = (ciOriginal eName, [Option{..}]) mkEOOption (eid, (ExamOccurrence{examOccurrenceName}, ceoId, (_,eName))) = (ciOriginal eName, [Option{..}])

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

@ -118,7 +118,7 @@ formatTimeW :: (HasLocalTime t, YesodAuthPersist UniWorX, AuthEntity UniWorX ~ U
formatTimeW s t = toWidget =<< formatTime s t formatTimeW s t = toWidget =<< formatTime s t
formatTimeMail :: (MonadMail m, HasLocalTime t) => SelDateTimeFormat -> t -> m Text formatTimeMail :: (MonadMail m, HasLocalTime t) => SelDateTimeFormat -> t -> m Text
formatTimeMail sel t = fmap fromString $ Time.formatTime <$> (getTimeLocale' . view _Wrapped <$> askMailLanguages) <*> (unDateTimeFormat <$> askMailDateTimeFormat sel) <*> pure (toLocalTime t) formatTimeMail sel t = fmap fromString $ (Time.formatTime . getTimeLocale' . view _Wrapped <$> askMailLanguages) <*> (unDateTimeFormat <$> askMailDateTimeFormat sel) <*> pure (toLocalTime t)
getTimeLocale :: MonadHandler m => m TimeLocale getTimeLocale :: MonadHandler m => m TimeLocale
getTimeLocale = getTimeLocale' <$> languages getTimeLocale = getTimeLocale' <$> languages

12
src/Utils.hs
View File

@ -783,6 +783,18 @@ adjustAssoc upd key = aux
groupSort :: (Ord k, Semigroup v) => [(k,v)] -> [(k,v)] groupSort :: (Ord k, Semigroup v) => [(k,v)] -> [(k,v)]
groupSort = Map.toAscList . Map.fromListWith (<>) groupSort = Map.toAscList . Map.fromListWith (<>)
-- -- Like groupSort, but also sort the
-- groupSortSorted :: (Ord k, Ord v, Semigroup v) => [(k,[v])] -> [(k,[v])]
-- groupSortSorted = Map.toAscList . Map.fromListWith merge
-- -- Merge to sorted list to a single sorted list. Precondition is not checked, but element will not be lost.
-- merge :: Ord a => [a] -> [a] -> [a]
-- merge [] ys = ys
-- merge xs [] = xs
-- merge xs@(x:xt) ys@(y:yt)
-- | x<=y = x : merge xt ys
-- | otherwise = y : merge xs yt
-- | Copied form Util from package ghc -- | Copied form Util from package ghc
partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
-- ^ Uses a function to determine which of two output lists an input element should join -- ^ Uses a function to determine which of two output lists an input element should join

3
templates/tutorial-participants.hamlet
View File

@ -18,7 +18,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section> <section>
^{participantTable} ^{participantTable}
<section> <section>
<h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed> $# <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
<h2>
_{MsgExamFormOccurrences} _{MsgExamFormOccurrences}
<div> <div>
<p> <p>

12
test/Database/Fill.hs
View File

@ -1235,12 +1235,12 @@ fillDb = do
, examOccurrenceRule = ExamRoomManual , examOccurrenceRule = ExamRoomManual
, examExamOccurrenceMapping = Nothing , examExamOccurrenceMapping = Nothing
, examPublishOccurrenceAssignments = Nothing , examPublishOccurrenceAssignments = Nothing
, examVisibleFrom = jtt TermDayLectureStart 0 Nothing toMidnight , examVisibleFrom = jtt TermDayLectureStart 0 Nothing toMidnight
, examRegisterFrom = jtt TermDayLectureStart 0 Nothing toMidnight , examRegisterFrom = jtt TermDayLectureStart 0 Nothing toMidnight
, examRegisterTo = jtt TermDayLectureStart 14 Nothing toMidnight , examRegisterTo = jtt TermDayLectureStart 14 Nothing toMidnight
, examDeregisterUntil = jtt TermDayLectureStart 21 Nothing toMidnight , examDeregisterUntil = jtt TermDayLectureStart 21 Nothing toMidnight
, examStart = jtt TermDayLectureStart 27 Nothing $ toTimeOfDay 16 0 0 , examStart = jtt TermDayLectureStart 0 Nothing $ toTimeOfDay 10 0 0
, examEnd = jtt TermDayLectureStart 32 Nothing $ toTimeOfDay 16 30 0 , examEnd = jtt TermDayLectureStart 128 Nothing $ toTimeOfDay 16 30 0
, examFinished = Nothing , examFinished = Nothing
, examPartsFrom = Nothing , examPartsFrom = Nothing
, examClosed = Nothing , examClosed = Nothing